Imports System
Imports System.Windows.Forms
Imports SharpDX
Imports SharpDX.DXGI
Imports SharpDX.Direct3D
Imports SharpDX.Direct3D11
Imports SharpDX.Direct2D1
Imports SharpDX.Windows
Imports SharpDX.Mathematics
Imports Device = SharpDX.Direct3D11.Device
Imports FactoryD2D = SharpDX.Direct2D1.Factory
Imports FactoryDXGI = SharpDX.DXGI.Factory1
Public Class SharpDXRenderer
#Region "Properties"
Private _showFPS As Boolean = False
Public Property ShowFPS() As Boolean
Get
Return _showFPS
End Get
Set(ByVal value As Boolean)
_showFPS = value
End Set
End Property
Private _renderWindow As New RenderForm
Public Property RenderWindow As RenderForm
Get
Return _renderWindow
End Get
Set(value As RenderForm)
_renderWindow = value
End Set
End Property
Private _renderWindowTitle As String = ""
Public Property RenderWindowTitle As Integer
Get
Return Nothing
End Get
Set(value As Integer)
End Set
End Property
Private _renderWindowWidth As Integer = 800
Public Property RenderWindowWidth() As String
Get
Return _renderWindowWidth
End Get
Set(ByVal value As String)
_renderWindowWidth = value
End Set
End Property
Private _renderWindowHeight As Integer = 600
Public Property RenderWindowHeight() As Integer
Get
Return _renderWindowHeight
End Get
Set(ByVal value As Integer)
_renderWindowHeight = value
End Set
End Property
Private _isWindowed As Boolean = True
Public Property IsWindowed() As Boolean
Get
Return _isWindowed
End Get
Set(ByVal value As Boolean)
_isWindowed = value
End Set
End Property
Private _refreshRate As Integer = 60
Public Property RefreshRate() As Integer
Get
Return _refreshRate
End Get
Set(ByVal value As Integer)
_refreshRate = value
End Set
End Property
#End Region
' **** Operational class level vars
Dim device As Device
Dim swapChain As SwapChain
Dim renderTarget As RenderTarget
Public Sub New()
'nuttin atm
End Sub
Public Sub Initialize()
' Create render target window
_renderWindow.Text = _renderWindowTitle
' Create swap chain description
Dim swapChainDesc = New SwapChainDescription() With {
.BufferCount = 2,
.Usage = Usage.RenderTargetOutput,
.OutputHandle = _renderWindow.Handle,
.IsWindowed = _isWindowed,
.ModeDescription = New ModeDescription(0, 0, New Rational(_refreshRate, 1), Format.R8G8B8A8_UNorm),
.SampleDescription = New SampleDescription(1, 0),
.Flags = SwapChainFlags.AllowModeSwitch,
.SwapEffect = SwapEffect.Discard
}
' Create swap chain And Direct3D device
' The BgraSupport flag Is needed for Direct2D compatibility otherwise RenderTarget.FromDXGI will fail!
Device.CreateWithSwapChain(DriverType.Hardware, DeviceCreationFlags.BgraSupport, swapChainDesc, device, swapChain)
' Get back buffer in a Direct2D-compatible format (DXGI surface)
Dim backBuffer As Surface = Surface.FromSwapChain(swapChain, 0)
'Create Direct2D factory
Using factory = New FactoryD2D()
'Get desktop DPI
Dim dpi = factory.DesktopDpi
'Create bitmap render target from DXGI surface
renderTarget = New RenderTarget(factory, backBuffer, New RenderTargetProperties() With {
.DpiX = dpi.Width,
.DpiY = dpi.Height,
.MinLevel = SharpDX.Direct2D1.FeatureLevel.Level_DEFAULT,
.PixelFormat = New PixelFormat(Format.Unknown, Direct2D1.AlphaMode.Ignore),
.Type = RenderTargetType.[Default],
.Usage = RenderTargetUsage.None
})
End Using
'Disable automatic ALT+Enter processing because it doesn't work properly with WinForms
Using factory = swapChain.GetParent(Of FactoryDXGI)()
factory.MakeWindowAssociation(_renderWindow.Handle, WindowAssociationFlags.IgnoreAltEnter)
End Using
' Add event handler for ALT+Enter
AddHandler _renderWindow.KeyDown, Sub(o, e)
If e.Alt AndAlso e.KeyCode = Keys.Enter Then
swapChain.IsFullScreen = Not swapChain.IsFullScreen
End If
End Sub
' Set window size
_renderWindow.Size = New System.Drawing.Size(_renderWindowWidth, _renderWindowHeight)
' Prevent window from being re-sized
_renderWindow.AutoSizeMode = AutoSizeMode.GrowAndShrink
End Sub
Public Sub RunRenderLoop()
Dim clock = New System.Diagnostics.Stopwatch()
Dim clockFrequency = CDbl(System.Diagnostics.Stopwatch.Frequency)
clock.Start()
Dim deltaTime = 0.0
Dim fpsTimer = New System.Diagnostics.Stopwatch()
fpsTimer.Start()
Dim fps = 0.0
Dim fpsFrames As Integer = 0
RenderLoop.Run(_renderWindow, Function()
renderTarget.BeginDraw()
renderTarget.Transform = Matrix3x2.Identity
renderTarget.Clear(Color.DarkBlue)
' FPS display
Dim totalSeconds = clock.ElapsedTicks / clockFrequency
fpsFrames += 1
If fpsTimer.ElapsedMilliseconds > 1000 Then
fps = 1000 * fpsFrames / fpsTimer.ElapsedMilliseconds
If _showFPS Then
' Update window title with FPS once every second
_renderWindow.Text = String.Format("D3DRendering D3D11.1 - FPS: {0:F2} ({1:F2}ms/frame)", fps, CSng(fpsTimer.ElapsedMilliseconds) / fpsFrames)
End If
' Restart the FPS counter
fpsTimer.Reset()
fpsTimer.Start()
fpsFrames = 0
End If
'Draw the frame
DrawFrame(renderTarget)
renderTarget.EndDraw()
swapChain.Present(0, PresentFlags.None)
' Determine the time it took to render the frame
deltaTime = (clock.ElapsedTicks / clockFrequency) - totalSeconds
End Function)
renderTarget.Dispose()
swapChain.Dispose()
device.Dispose()
End Sub
Private Function DrawFrame(renderTarget As RenderTarget) As RenderTarget
renderTarget.DrawRectangle(New RectangleF(renderTarget.Size.Width / 2 - (Form1.WidthTB.Value / 2),
renderTarget.Size.Height / 2 - (Form1.HeightTB.Value / 2),
Form1.WidthTB.Value,
Form1.HeightTB.Value), New SolidColorBrush(renderTarget, Color.CornflowerBlue))
Return renderTarget
End Function
End Class
Mostrar Mensajes
