CAD-Viewer 3DVBVIEW für 3D-Modell mit Quellcode für Visual Studio 2017 und Windows10 mit DirectX9

Direkt zum Seiteninhalt

Hauptmenü

3DVBVIEW

Programmieren Sie komplexe 3D-Programme mit Visual Basic und DirectX9 mit den neuesten Microsoft-Compilern wie Visual Studio Express Desktop 2008, 2013 und 2015 für Windows 7 - 10 ohne C++ Kenntnisse zu benötigen. 3DVBVIEW ist auch als Lernprogramm geeignet für alle die von Visual Basic 6.0 auf VB.NET wechseln wollen oder keine Bücher oder Tutorials zu Visual Basic und DirectX9  finden können. DirectX9 ist eine stabile DirectX-Engine die auch problemlos auf Windows 10 läuft.
 

Use 3D programs with Visual Basic.NET and DirectX9 with the newest Microsoft compilers, such as Visual Studio Express Desktop 2015 and 2017 for Windows 7 - 10 without C ++ knowledge. 3DVBVIEW is also suitable as a tutorial for all those who want to switch from Visual Basic 6.0 to VB.NET or can not find any books for Visual Basic and DirectX.

Wird das 3DVBVIEW-Projekt in Visual Studio 2015 oder 2017 eingeladen erscheint eine Dialogbox, diese mit "Weiter" weiterklicken dann wird DirectX9-DLL eingeladen und 3DVBVIEW kann weiterbearbeitet werden.

If the 3DVBVIEW project is loaded into Visual Studio 2015 or 2017, a dialogbox will be displayed, click "Next" then DirectX9 DLL will be loaded and 3DVBVIEW can be further processed.

Eine neue DirectX11-Engine mit Vertexshader und Pixelshader wird ebenfalls angeboten.
DirectX11 ist der Nachfolger von DirectX9.

New DirectX11-Engine with VertexShader and PixelShader

 

Part of the Source-Code with DirectX11:

Here you can purchase the entire code Visual Basic 2017


Imports DX11Engine
Imports SlimDX
Imports SlimDX.Direct3D11
Public Class Form1

   Private _DX11Device As DX11Device
   Private _Scene As Scene
   Private _ShaderManagement As ShaderManagement                  ' referes to unmanaged resource, to dispose
   Private _MouseProvider As MouseProvider
   Private _CameraProvider As CameraProviderOrbital
   Private _RenderLock As Boolean

   Private _ModelMaterial As MaterialVertexColor
   Private _MeshMaterial As MaterialPlainColor                     ' referes to unmanaged resource, to dispose

   Private _ModelGeometry As GeometryData                          ' referes to unmanaged resource, to dispose



''' <summary>
   ''' Returns the facet 'under' the given (mouse) position.
   ''' </summary>
   ''' <remarks>
   ''' The camera ray directs from the camera origin to the mouse cursor.
   ''' </remarks>
   Private Function FindFacet(PosX As Integer, PosY As Integer) As Integer

       Dim pickray As Ray
       pickray = _Scene.GetCameraRay(PosX, PosY)

       Dim v1 As Vector3
       Dim v2 As Vector3
       Dim v3 As Vector3

       Dim dist As Single
       Dim mindist As Single = 1000000.0F
       Dim picked As Integer

       Dim i As Integer

       For i = 1 To nel

           v1.X = din8(in7(i, 1), 1)
           v1.Y = din8(in7(i, 1), 2)
           v1.Z = din8(in7(i, 1), 3)

           v2.X = din8(in7(i, 2), 1)
           v2.Y = din8(in7(i, 2), 2)
           v2.Z = din8(in7(i, 2), 3)

           v3.X = din8(in7(i, 3), 1)
           v3.Y = din8(in7(i, 3), 2)
           v3.Z = din8(in7(i, 3), 3)

           If Ray.Intersects(pickray, v1, v2, v3, dist) Then

               If dist < mindist Then
                   picked = i
                   mindist = dist
               End If

           End If

       Next

       'Diagnostics.Debug.Print("Intersects: " & picked.ToString & " d " & mindist.ToString)

       Return picked

   End Function


   ''' <summary>
   ''' Creates a new Form1 instance.
   ''' </summary>
   Public Sub New()

       ' Dieser Aufruf ist für den Designer erforderlich.
       InitializeComponent()

       ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.

       'Me.Show()

       RenderPanel.Dock = DockStyle.Fill 'Width = Me.Width
       'RenderPanel.Height = Me.Height     ' - Ribbon2.Size.Height
       Me.Show()

       If Not InitializeDevice() Then
           MsgBox("The creation of the DirectX 11 primary device failed." + vbCrLf + "Please update your video driver to the latest version." _
           + vbCrLf + "If this problem persists, please contact support.")
           Me.Close()
           Application.Exit()
       End If

       If Not InitializeScene() Then
           MsgBox("The creation of the DirectX 11 environment failed." + vbCrLf + "Please update your video driver to the latest version." _
           + vbCrLf + "If this problem persists, please contact support.")
           Me.Close()
           Application.Exit()
       End If

   End Sub

   ''' <summary>
   ''' Renders the scene.
   ''' </summary>
   Public Sub Render()

       If _RenderLock Then Exit Sub

       _Scene.ClearScene()

       If _ModelGeometry Is Nothing Then Exit Sub

       _Scene.UpdateCamera(_CameraProvider)

       _ModelGeometry.Apply()

       If mnuViewSolid.Checked Then

           _Scene.ModeSolid()
           _Scene.ZTestEnabled()

           _ModelMaterial.Apply()

           _ModelGeometry.Draw()

       End If

       If mnuViewWireframe.Checked Then

           _Scene.ModeWireframe()
           _Scene.ZTestOverlay()

           '_MeshMaterial.MatColor = Color.FromArgb(0, 0, 0)  ' black is the default color

           _MeshMaterial.Apply()

           _ModelGeometry.Draw()

       End If

       _Scene.Present()

   End Sub

   ''' <summary>
   ''' Initializes the Direct3D11 device.
   ''' </summary>
   Private Function InitializeDevice() As Boolean

#If DEBUG Then
       _DX11Device = New DX11Device(FeatureLevel.Level_11_0, FeatureLevel.Level_10_1, DeviceCreationFlags.Debug)
#Else
       _DX11Device = New DX11Device(FeatureLevel.Level_11_0, FeatureLevel.Level_10_1, DeviceCreationFlags.None)
#End If

       If _DX11Device.LastError <> 0 Then

           If _DX11Device IsNot Nothing Then
               _DX11Device.Dispose()
               _DX11Device = Nothing
           End If

           Return False

       End If

       Return True

   End Function

   ''' <summary>
   ''' Initializes a basic Direct3D11 scene and the scene dependencies.
   ''' </summary>
   ''' <remarks>
   ''' The term Scene describes an empty environment with more or less functionality built in
   ''' that can be controlled with the scene properties and methods.
   '''
   ''' MouseProvider and CameraProvider are input objects that provide a conveniant way to move
   ''' around the scene.
   ''' </remarks>
   Private Function InitializeScene() As Boolean

       _Scene = New Scene(_DX11Device, RenderPanel)

       If _Scene.LastError <> EngineResult.OK Then
           Return False
       End If

       _Scene.ClearColor = Color.FromArgb(192, 192, 192)        ' (i1_hintergrund, i2_hintergrund, i3_hintergrund)

       _CameraProvider = New CameraProviderOrbital(3, New Vector3(0, 0, 0))

       _MouseProvider = New MouseProvider(RenderPanel, True)

       ' Create a shader management object, it will compile, manage and provide all shaders that
       ' are needed to build the material classes.

#If DEBUG Then
       _ShaderManagement = New ShaderManagement(_DX11Device, D3DCompiler.ShaderFlags.Debug, ShaderManagement.ShaderModel.Model_4_1)
#Else
       _ShaderManagement = New ShaderManagement(_DX11Device, D3DCompiler.ShaderFlags.OptimizationLevel1, ShaderManagement.ShaderModel.Model_4_1)
#End If

       ' Create materials. Unless there are hundreds of materials and adding materials on the fly
       ' is wanted, it's a good idea to create all materials now. Compiling from resource is time
       ' consuming and may later result in a less fluent output.

       _ModelMaterial = New MaterialVertexColor(_ShaderManagement, VertexLayout.PositionNormalColored)
       _MeshMaterial = New MaterialPlainColor(_ShaderManagement, VertexLayout.PositionNormalColored)

       ' Add event handlers, to deal with mouse events and form or control resize events.

       AddHandler _MouseProvider.OnControlMouseChanges, AddressOf MouseInput
       AddHandler RenderPanel.Resize, AddressOf ResizeScene

       Return True

   End Function

   ''' <summary>
   ''' Handles the resize event of the RenderPanel control.
   ''' </summary>
   Private Sub ResizeScene(s As Object, e As EventArgs)

       _Scene.OnResize(RenderPanel.Width, RenderPanel.Height)
       Me.Render()

   End Sub

   ''' <summary>
   ''' Handles the mouse events of the RenderPanel control.
   ''' </summary>
   Private Sub MouseInput(Data As MouseProvider.MouseData)
       Select Case Data.MouseEvent
           Case MouseProvider.MouseEvents.Down
           Case MouseProvider.MouseEvents.Move
               If Data.MouseKey = MouseButtons.Left Then
                   _CameraProvider.Update(Data.PositionDelta, 0.2)
                   Me.Render()
               End If

           Case MouseProvider.MouseEvents.Wheel
               _CameraProvider.Update(Data.WheelDelta, 0.5)
               Me.Render()
       End Select
   End Sub

   ''' <summary>
   ''' Converts the global arrays to Direct3D11 VertexBuffer and IndexBuffer.
   ''' </summary>
   Private Sub CreateOrUpdateModel()

       _RenderLock = True

       If _ModelGeometry IsNot Nothing Then _ModelGeometry.Dispose()

       _ModelGeometry = New GeometryData(_DX11Device, VertexLayout.PositionNormalColored)

       _RenderLock = False

   End Sub

   ''' <summary>
   ''' Handles the FormClosing event. Free all resources here.
   ''' </summary>
   Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing

       _DX11Device.Dispose()

   End Sub

   ''' <summary>
   ''' Loads a .mup/.fem file.
   ''' </summary>
   Private Sub mnuFileOpen_Click(sender As Object, e As EventArgs) Handles mnuFileOpen.Click

       Call einladen()

       Me.CreateOrUpdateModel()
       Me.Render()

   End Sub

   ''' <summary>
   ''' Imports a .stl file.
   ''' </summary>
   Private Sub mnuFileImport_Click(sender As Object, e As EventArgs) Handles mnuFileImport.Click

       Call stl_importieren()

       Me.CreateOrUpdateModel()
       Me.Render()

   End Sub

   ''' <summary>
   ''' Exits the Application.
   ''' </summary>
   Private Sub mnuFileExit_Click(sender As Object, e As EventArgs) Handles mnuFileExit.Click
       Me.Close()
       Application.Exit()
   End Sub

   ''' <summary>
   ''' Enables or disables the solid drawing state.
   ''' </summary>
   Private Sub mnuViewSolid_Click(sender As Object, e As EventArgs) Handles mnuViewSolid.Click
       mnuViewSolid.Checked = Not mnuViewSolid.Checked
       Me.Render()
   End Sub

   ''' <summary>
   ''' Enables or disables the wireframe drawing state.
   ''' </summary>
   Private Sub mnuViewWireframe_Click(sender As Object, e As EventArgs) Handles mnuViewWireframe.Click
       mnuViewWireframe.Checked = Not mnuViewWireframe.Checked
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Hides or shows part/group 1.
   ''' </summary>
   Private Sub mnuModelHide1_Click(sender As Object, e As EventArgs) Handles mnuModelHide1.Click
       mnuModelHide1.Checked = Not mnuModelHide1.Checked
       If mnuModelHide1.Checked = True Then
           in5(1, 4) = -1
       Else
           in5(1, 4) = 1
       End If
       Me.CreateOrUpdateModel()
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Hides or shows part/group 2.
   ''' </summary>
   Private Sub mnuModelHide2_Click(sender As Object, e As EventArgs) Handles mnuModelHide2.Click
       mnuModelHide2.Checked = Not mnuModelHide2.Checked
       If mnuModelHide2.Checked = True Then
           in5(2, 4) = -1
       Else
           in5(2, 4) = 1
       End If
       Me.CreateOrUpdateModel()
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Sets the ambient intensity to 10 percent.
   ''' </summary>
   Private Sub mnuLightAmbient10_Click(sender As Object, e As EventArgs) Handles mnuLightAmbient10.Click
       mnuLightAmbient10.Checked = True
       _Scene.AmbientIntensity = 0.1F
       Me.UncheckAmbientMenu()
       mnuLightAmbient10.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Sets the ambient intensity to 20 percent.
   ''' </summary>
   Private Sub mnuLightAmbient20_Click(sender As Object, e As EventArgs) Handles mnuLightAmbient20.Click
       _Scene.AmbientIntensity = 0.2F
       Me.UncheckAmbientMenu()
       mnuLightAmbient20.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Sets the ambient intensity to 30 percent.
   ''' </summary>
   Private Sub mnuLightAmbient30_Click(sender As Object, e As EventArgs) Handles mnuLightAmbient30.Click
       _Scene.AmbientIntensity = 0.3F
       Me.UncheckAmbientMenu()
       mnuLightAmbient30.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Sets the ambient intensity to 40 percent.
   ''' </summary>
   Private Sub mnuLightAmbient40_Click(sender As Object, e As EventArgs) Handles mnuLightAmbient40.Click
       _Scene.AmbientIntensity = 0.4F
       Me.UncheckAmbientMenu()
       mnuLightAmbient40.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Demo. Sets the ambient intensity to 50 percent.
   ''' </summary>
   Private Sub mnuLightAmbient50_Click(sender As Object, e As EventArgs) Handles mnuLightAmbient50.Click
       _Scene.AmbientIntensity = 0.5F
       Me.UncheckAmbientMenu()
       mnuLightAmbient50.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Unchecks all ambient menu items.
   ''' </summary>
   Private Sub UncheckAmbientMenu()
       mnuLightAmbient10.Checked = False
       mnuLightAmbient20.Checked = False
       mnuLightAmbient30.Checked = False
       mnuLightAmbient40.Checked = False
       mnuLightAmbient50.Checked = False
   End Sub

   ''' <summary>
   ''' Sets the light color to pure white.
   ''' </summary>
   Private Sub mnuLightColorPureWhite_Click(sender As Object, e As EventArgs) Handles mnuLightColorPureWhite.Click
       _Scene.LightColor = Color.FromArgb(255, 255, 255)
       Me.UncheckLightColorMenu()
       mnuLightColorPureWhite.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Sets the light color to dayly grey.
   ''' </summary>
   Private Sub mnuLightColorDaylyGrey_Click(sender As Object, e As EventArgs) Handles mnuLightColorDaylyGrey.Click
       _Scene.LightColor = Color.FromArgb(179, 179, 179)
       Me.UncheckLightColorMenu()
       mnuLightColorDaylyGrey.Checked = True
       Me.Render()
   End Sub

   ''' <summary>
   ''' Opens a dialog to select the color.
   ''' </summary>
   Private Sub mnuLightColorUserDefined_Click(sender As Object, e As EventArgs) Handles mnuLightColorUserDefined.Click
       Dim dialog As New ColorDialog
       If dialog.ShowDialog() = DialogResult.OK Then
           _Scene.LightColor = dialog.Color
           Me.UncheckLightColorMenu()
           mnuLightColorUserDefined.Checked = True
       End If
       Me.Render()
   End Sub

   ''' <summary>
   ''' Unchecks all light color menu items.
   ''' </summary>
   Private Sub UncheckLightColorMenu()
       mnuLightColorPureWhite.Checked = False
       mnuLightColorDaylyGrey.Checked = False
       mnuLightColorUserDefined.Checked = False
   End Sub

   ''' <summary>
   ''' Saves the application configuration.
   ''' </summary>
   Public Sub netzwerk_sichern()
       ' Dummy, called by STL_importieren.
   End Sub





  ''' <summary>
   ''' Returns the vertex 'under' the given (mouse) position.
   ''' </summary>
   ''' <remarks>
   ''' Projects each vertex from world to screen coordinates and test if it's near the mouse position.
   ''' If it's within a given distance to the mouse, the world space distance to the camera is eval-
   ''' uated, the vertex that is nearest to the camera is returned.
   ''' </remarks>
   Private Function FindVertex(PosX As Integer, PosY As Integer) As Integer

       ' Unprojects the camera position (0,0,0) to world space.

       Dim invView As Matrix
       Dim camZero As Vector3

       invView = Matrix.Invert(_Scene.GetView)
       camZero = Vector3.TransformCoordinate(New Vector3(), invView)

       ' Projection matrix for the world to screen transformation

       Dim viewProj As Matrix
       viewProj = _Scene.GetViewProjection

       Dim v1 As Vector3
       Dim v2 As Vector3

       Dim dist1 As Integer
       Dim dist2 As Single
       Dim mindist As Single = 1000000.0F
       Dim picked As Integer

       Dim i As Integer

       For i = 1 To neck

           v1.X = din8(i, 1)
           v1.Y = din8(i, 2)
           v1.Z = din8(i, 3)

           v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

           dist1 = ScreenDistance(v2.X, v2.Y, PosX, PosY)

           ' If screen distance to the mouse < 10 pixels, test vertex to camera distance

           If dist1 < 10 Then

               dist2 = WorldDistance(camZero, v1)

               If dist2 < mindist Then
                   picked = i
                   mindist = dist2
               End If

               Diagnostics.Debug.Print("Picked: " & i.ToString & " d1 " & dist1.ToString & " d2 " & dist2.ToString)

           End If

       Next

       Return picked

   End Function

 
 
 
 
Zurück zum Seiteninhalt | Zurück zum Hauptmenü