Attribute VB_Name = "Directx"
'// Programmed by Ervin Louie B. Pe Benito
'// directx.bas
'// DX graphics module
Option Explicit
Public Dx As DirectX8
Public D3D As Direct3D8
Public Dev As Direct3DDevice8
Public bwindowed As Boolean
'Flexable-Vertex-Formation For 2D Verticies
Private Const FVF = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Public MousePos As Point
Public Misc(0 To 40) As Direct3DTexture8  'All Misc Textures That Are Not Used On Game Screen
Public Tiles(0 To 17) As Direct3DTexture8
Public SceneBackground(0 To 5) As Direct3DTexture8

Public Const Colorkey = &HFF000000
'Describes A Transformed And Lit Vertex
Private Type TLVERTEX
    x As Single
    y As Single
    z As Single
    rhw As Single
    Color As Long
    specular As Long
    tu As Single
    tv As Single
End Type
Public Vertex(0 To 3) As TLVERTEX

'Misc
Private MainFont As D3DXFont    'Used For Font
Public D3DX As New D3DX8

Public GameWidth As Long
Public GameHeight As Long


Public Function DXInit() As Boolean
On Error GoTo errhandler
    GameWidth = 640
    GameHeight = 480
    'Describe the display mode
    Dim DispMode As D3DDISPLAYMODE
    'Describe the viewport
    Dim D3DWindow As D3DPRESENT_PARAMETERS
    'Create the master object, them parent class of dx
    Set Dx = New DirectX8
    'make our master object to create a direct3d interface
    Set D3D = Dx.Direct3DCreate()
    'set the display mode whether windowed or fullscreen mode
    If bwindowed = True Then 'if windowed mode
        'Retrieve the current display mode
        D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
    
        'Initializing our d3dwindow or viewport
        D3DWindow.Windowed = 1 'This tells the dx that we are in winmode
        D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC 'we will refresh as the monitor does
        D3DWindow.BackBufferFormat = DispMode.Format 'we will use the format we have just retrieved
    
        MousePos.x = 0
        MousePos.y = 0
    Else 'else fullscreen mode
        ' DispMode.Format = D3DFMT_X8R8G8B8 '32 bit mode
        DispMode.Format = D3DFMT_R5G6B5 '16 bit mode
        DispMode.width = GameWidth
        DispMode.height = GameHeight

        D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP
        D3DWindow.BackBufferCount = 1 '//1 backbuffer only
        D3DWindow.BackBufferFormat = DispMode.Format 'What we specified earlier
        D3DWindow.BackBufferHeight = GameHeight 'set screen height
        D3DWindow.BackBufferWidth = GameWidth 'set screen width
        D3DWindow.hDeviceWindow = frmMain.hWnd 'the window handle
        
        'Starting MousePosition
        MousePos.x = (GameWidth) / 2
        MousePos.y = (GameHeight) / 2
    End If
    
    Set Dev = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, _
                                    D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DWindow)
    
    
    
    Dev.SetVertexShader FVF
    Dev.SetRenderState D3DRS_LIGHTING, False
    ' Enable alpha blending for transparency
    Dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
    Dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
    Dev.SetRenderState D3DRS_ALPHABLENDENABLE, True
    
    'Create The Custom Font
    setfont "arial", 8
    
    'Setup Parts of A Vertex That Will Be Constant
    Vertex(0).z = 0: Vertex(0).rhw = 1: Vertex(0).specular = 0: Vertex(0).tu = 0: Vertex(0).tv = 0
    Vertex(1).z = 0: Vertex(1).rhw = 1: Vertex(1).specular = 0: Vertex(1).tu = 1: Vertex(1).tv = 0
    Vertex(2).z = 0: Vertex(2).rhw = 1: Vertex(2).specular = 0: Vertex(2).tu = 0: Vertex(2).tv = 1
    Vertex(3).z = 0: Vertex(3).rhw = 1: Vertex(3).specular = 0: Vertex(3).tu = 1: Vertex(3).tv = 1
    
    'dx init has been succeeded
    DXInit = True
    Exit Function
'// the dx init has just failed
errhandler:
    DXInit = False
End Function

Public Sub ClearScreen()
    '//1. We need to clear the render device before we can draw anything
    '       This must always happen before you start rendering stuff...
    Dev.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0
    'the hexidecimal value in the middle is the same as when you're using colours in HTML - if you're familiar
    'with that.
End Sub

Public Sub RenderBegin()
    '//2. Next we would render everything.

    Dev.BeginScene
End Sub

Public Sub RenderEnd()
   '//then we will stop rendering
    Dev.EndScene
End Sub

Public Sub FlipScreen()
    '//3. Update the frame to the screen...
    Dev.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

'needed to free the memory
Public Sub DXdestroy()
    Dim x As Integer
    For x = 0 To 40
        Set Misc(x) = Nothing
    Next
    For x = 0 To 17
        Set Tiles(x) = Nothing
    Next
    For x = 0 To 5
        Set SceneBackground(x) = Nothing
    Next
    Set D3DX = Nothing
    Set Dev = Nothing
    Set D3D = Nothing
    Set Dx = Nothing
    Debug.Print "All Objects Destroyed"
End Sub

'This will set the size of the square.... by setting vertices
'Left = the starting x pos
'Top = the starting y pos
'Height = the size of square from top
'Color1 = the color or 1st vertex
'color2 = the color of 2nd vertex
'color3 = the color of 3rd vertex
'color4 = the color of 4th vertex

Public Sub Set_Vertex(ByVal Left As Single, ByVal Top As Single, ByVal width As Single, ByVal height As Single, ByVal Color1 As Long, ByVal Color2 As Long, ByVal Color3 As Long, ByVal Color4 As Long)

With Vertex(0)  'Set Vertex 1
    .x = Left: .y = Top:  .Color = Color1
End With
With Vertex(1)  'Set Vertex 2
    .x = Left + width: .y = Top: .Color = Color2
End With
With Vertex(2)  'Set Vertex 3
    .x = Left: .y = Top + height: .Color = Color3
End With
With Vertex(3)  'Set Vertex 4
    .x = Left + width: .y = Top + height: .Color = Color4
End With

End Sub

'Used to draw text in the dx window
Public Sub Draw_Text(ByVal Left As Integer, ByVal Top As Integer, ByVal width As Integer, ByVal height As Integer, Text As String, ByVal Color As Long, ByVal Format As Long)
Dim TextArea As RECT

'Setup The Text Area
TextArea.Top = Top
TextArea.Left = Left
TextArea.Right = width + Left
TextArea.bottom = height + Top

'Draw The Text
D3DX.DrawText MainFont, Color, Text, TextArea, Format

End Sub
Public Sub setfont(sFontname As String, lSize As Long)
        'sets the font
    Dim Fnt As New StdFont
    Dim MainFontDesc As IFont
    'Set The Font Size
    Fnt.Size = lSize
    Fnt.Name = sFontname
    Set MainFontDesc = Fnt
    Set MainFont = D3DX.CreateFont(Dev, MainFontDesc.hFont)   'Apply The Font
End Sub
