Option Explicit On
Option Strict On
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Public Class frmMain
Private Const COLOR_DEPTH_16_BIT As Format = Format.R5G6B5
Private Const COLOR_DEPTH_24_BIT As Format = Format.A8R8G8B8
Private Const COLOR_DEPTH_32_BIT As Format = Format.X8R8G8B8
Private Direct3D_Device As Device
Private Fullscreen_Enabled As Boolean
Private Running As Boolean = True
Private Vertex_List As CustomVertex.TransformedColoredTextured() = New CustomVertex.TransformedColoredTextured(0 To 3) {} 'create an array of vertices
Private Texture As Texture
Private Alpha As Integer
Private Function Create_TLVertex(ByVal X As Single, ByVal Y As Single, ByVal Z As Single, ByVal Color As Integer, ByVal TU As Integer, ByVal TV As Integer) As CustomVertex.TransformedColoredTextured
Create_TLVertex.Position = New Vector4(X, Y, Z, 1)
Create_TLVertex.Color = Color
Create_TLVertex.Tu = TU
Create_TLVertex.Tv = TV
End Function
Private Sub DirectX9_Initialize()
Dim Display_Mode As DisplayMode
Dim Direct3D_Window As PresentParameters = New PresentParameters
If Fullscreen_Enabled = True Then
Display_Mode.Width = 800
Display_Mode.Height = 600
Display_Mode.Format = COLOR_DEPTH_16_BIT
'Check to see if fullscreen mode is supported before you use it.
If Manager.CheckDeviceType(0, DeviceType.Hardware, Display_Mode.Format, Display_Mode.Format, False) Then
' Perfect, this is valid
Direct3D_Window.Windowed = False
Direct3D_Window.BackBufferCount = 1
Direct3D_Window.BackBufferWidth = Display_Mode.Width
Direct3D_Window.BackBufferHeight = Display_Mode.Height
Else
MessageBox.Show("Your video card doesn't support this screen resolution.", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Else
Direct3D_Window.Windowed = True
End If
Direct3D_Window.SwapEffect = SwapEffect.Copy
Direct3D_Window.BackBufferFormat = Display_Mode.Format
'Create our device
Direct3D_Device = New Device(0, DeviceType.Hardware, Me.Handle, CreateFlags.SoftwareVertexProcessing, Direct3D_Window)
'Right here will alphablend the polygon
Direct3D_Device.SetRenderState(RenderStates.AlphaBlendEnable, True)
'Needed for alphablending
'----------------------------------------------------------------------------------------------------
Direct3D_Device.SetTextureStageState(0, TextureStageStates.ColorOperation, TextureOperation.Modulate)
Direct3D_Device.SetTextureStageState(0, TextureStageStates.ColorArgument1, TextureArgument.TextureColor)
Direct3D_Device.SetTextureStageState(0, TextureStageStates.ColorArgument2, TextureArgument.Diffuse)
Direct3D_Device.SetTextureStageState(0, TextureStageStates.AlphaOperation, TextureOperation.Modulate)
Direct3D_Device.SetTextureStageState(0, TextureStageStates.AlphaArgument1, TextureArgument.TextureColor)
Direct3D_Device.SetTextureStageState(0, TextureStageStates.AlphaArgument2, TextureArgument.Diffuse)
Direct3D_Device.SetRenderState(RenderStates.SourceBlend, Blend.SourceAlpha)
Direct3D_Device.SetRenderState(RenderStates.DestinationBlend, Blend.InvSourceAlpha)
Direct3D_Device.SetRenderState(RenderStates.BlendOperation, TextureOperation.Add)
'----------------------------------------------------------------------------------------------------
'These lines are not needed, but it's nice to be able to filter the
'textures to make them look nicer.
Direct3D_Device.SetSamplerState(0, SamplerStageStates.MinFilter, TextureFilter.Point)
Direct3D_Device.SetSamplerState(0, SamplerStageStates.MagFilter, TextureFilter.Point)
End Sub
Private Sub Create_Polygon()
Vertex_List(0) = Create_TLVertex(0, 0, 0, System.Drawing.Color.FromArgb(Alpha, 255, 255, 255).ToArgb, 0, 0)
Vertex_List(1) = Create_TLVertex(100, 0, 0, System.Drawing.Color.FromArgb(Alpha, 255, 255, 255).ToArgb, 1, 0)
Vertex_List(2) = Create_TLVertex(0, 100, 0, System.Drawing.Color.FromArgb(Alpha, 255, 255, 255).ToArgb, 0, 1)
Vertex_List(3) = Create_TLVertex(100, 100, 0, System.Drawing.Color.FromArgb(Alpha, 255, 255, 255).ToArgb, 1, 1)
End Sub
Private Sub Draw_Polygon()
Direct3D_Device.VertexFormat = CustomVertex.TransformedColoredTextured.Format
Direct3D_Device.SetTexture(0, Texture)
Direct3D_Device.DrawUserPrimitives(PrimitiveType.TriangleStrip, 2, Vertex_List)
End Sub
Private Sub Load_Texture(ByVal Filepath As String, ByVal Transparency_Color As Integer)
Texture = TextureLoader.FromFile(Direct3D_Device, Filepath, 512, 512, 1, Usage.None, Format.A8B8G8R8, Pool.Managed, Filter.Point, Filter.Point, Transparency_Color)
End Sub
Private Sub Render()
Direct3D_Device.Clear(ClearFlags.Target, Color.Black, 1.0, 0)
Direct3D_Device.BeginScene()
'Rendering code goes here.
Create_Polygon()
Draw_Polygon()
Direct3D_Device.EndScene()
Direct3D_Device.Present()
Application.DoEvents()
End Sub
Private Sub Game_Loop()
Do While Running = True
Render()
Loop
End Sub
Private Sub Main()
If MessageBox.Show("Click Yes to go to full screen (Recommended)", "", MessageBoxButtons.YesNo, MessageBoxIcon.Information) = DialogResult.Yes Then
Fullscreen_Enabled = True
End If
With Me
.Show()
.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.Opaque, True) 'Do not draw forms background
.Text = "DirectX Tutorial"
If Fullscreen_Enabled = True Then .FormBorderStyle = Windows.Forms.FormBorderStyle.None
End With
DirectX9_Initialize()
Load_Texture(Application.StartupPath() & "\Sprite1.png", System.Drawing.Color.FromArgb(0, 0, 0, 0).ToArgb)
Alpha = 255
Running = True
End Sub
Private Sub Shutdown()
Running = False
Texture = Nothing
Direct3D_Device = Nothing
Application.Exit()
End Sub
Private Sub frmMain_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
If e.KeyCode = Keys.Escape Then Shutdown()
'Press and hold Left or Right keys to change the Alpha values and watch the image fade away!
If e.KeyCode = Keys.Left Then
Alpha -= 5
If Alpha <= 0 Then Alpha = 0
End If
If e.KeyCode = Keys.Right Then
Alpha += 5
If Alpha >= 255 Then Alpha = 255
End If
End Sub
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Main()
End Sub
Private Sub frmMain_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
Shutdown()
End Sub
Private Sub frmMain_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Game_Loop()
End Sub
Private Sub frmMain_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
If Fullscreen_Enabled = False Then
Running = False
Render()
Running = True
End If
End Sub
End Class