Rock-Solid dxGraphics Enumeration in VB

[Sastraxi]

I've compiled a series of functions to return the best 3D card's index based on maximum resolution, rendering layer (hal and ref), and device (puredevice, hardware_vertexprocessing, and software_vertexprocessing). I thought everyone can benefit from my hour's worth of work if I posted it here.

Enjoy!

Function RetRenderer(Adapter As Long) As Long
On Local Error Resume Next
Dim DevCaps As D3DCAPS8
 
D3D.GetDeviceCaps Adapter, D3DDEVTYPE_HAL, DevCaps
 
'If (DevCaps.DevCaps And D3DDEVCAPS_PUREDEVICE) Then
'    RetRenderer = D3DCREATE_PUREDEVICE
'    Exit Function
'Else
'End If
 
If (DevCaps.DevCaps And D3DDEVCAPS_HWTRANSFORMANDLIGHT) Then
    RetRenderer = D3DCREATE_HARDWARE_VERTEXPROCESSING
    Exit Function
Else
End If
 
If Err.Number = D3DERR_INVALIDDEVICE Or D3DERR_NOTAVAILABLE Then
    RetRenderer = D3DCREATE_SOFTWARE_VERTEXPROCESSING
End If
End Function
 
Function RetLayer(Adapter As Long) As CONST_D3DDEVTYPE
On Local Error Resume Next
Dim DevCaps As D3DCAPS8
 
D3D.GetDeviceCaps Adapter, D3DDEVTYPE_HAL, DevCaps
 
If Err.Number = D3DERR_INVALIDDEVICE Or Err.Number = D3DERR_NOTAVAILABLE Then
    RetLayer = D3DDEVTYPE_REF
    Exit Function
End If
 
RetLayer = D3DDEVTYPE_HAL
End Function
 
Function RetLargeMode(Layer As CONST_D3DDEVTYPE, Adapter As Long) As D3DDISPLAYMODE
Dim I As Integer, ModeTemp As D3DDISPLAYMODE, LastModeTemp As D3DDISPLAYMODE
 
nModes = D3D.GetAdapterModeCount(Adapter)
 
LastModeTemp.Height = 1
LastModeTemp.Width = 1
LastModeTemp.Format = D3DFMT_A8R3G3B2
LastModeTemp.RefreshRate = 0
 
For I = 0 To nModes - 1
    Call D3D.EnumAdapterModes(Adapter, I, ModeTemp)
    
    If ModeTemp.Format = D3DFMT_R8G8B8 Or ModeTemp.Format = D3DFMT_X8R8G8B8 Or ModeTemp.Format = D3DFMT_A8R8G8B8 Then
        If D3D.CheckDeviceType(Adapter, Layer, ModeTemp.Format, ModeTemp.Format, False) >= 0 Then
            If LargerBPP(ModeTemp, LastModeTemp) Then
                If ModeTemp.Width >= LastModeTemp.Width Then
                    If ModeTemp.Height >= LastModeTemp.Height Then
                        If ModeTemp.RefreshRate >= LastModeTemp.RefreshRate Then
                            LastModeTemp = ModeTemp
                        End If
                    End If
                End If
            End If
        End If
    Else
        If D3D.CheckDeviceType(Adapter, Layer, ModeTemp.Format, ModeTemp.Format, False) >= 0 Then
            If LargerBPP(ModeTemp, LastModeTemp) Then
                If ModeTemp.Width >= LastModeTemp.Width Then
                    If ModeTemp.Height >= LastModeTemp.Height Then
                        If ModeTemp.RefreshRate >= LastModeTemp.RefreshRate Then
                            LastModeTemp = ModeTemp
                        End If
                    End If
                End If
            End If
        End If
    End If
    
Next I
 
RetLargeMode = LastModeTemp
 
End Function
 
Public Function GetBest3DAdapter() As Long
Dim nAdapters As Long
Dim I As Long
Dim cLayer() As CONST_D3DDEVTYPE
Dim cRenderer() As Long
Dim cLargeMode() As D3DDISPLAYMODE
Dim BestAdapter As Long
Dim BetterFlag As Boolean
 
    nAdapters = D3D.GetAdapterCount
    If nAdapters = 1 Then
        GetBest3DAdapter = 0
        Exit Function
    End If
    
    ReDim cLayer(nAdapters) As CONST_D3DDEVTYPE
    ReDim cRenderer(nAdapters) As Long
    ReDim cLargeMode(nAdapters) As D3DDISPLAYMODE
    
    For I = 0 To nAdapters - 1
        cLayer(I) = RetLayer(I)
        cRenderer(I) = RetRenderer(I)
        cLargeMode(I) = RetLargeMode(cLayer(I), I)
    Next I
 
    BestAdapter = 0
 
    For I = 1 To nAdapters - 1
        BetterFlag = False
        If cLayer(I) = D3DDEVTYPE_HAL And cLayer(BestAdapter) <> D3DDEVTYPE_HAL Then
            BetterFlag = True
        Else
            If cRenderer(I) = D3DCREATE_PUREDEVICE And cLayer(BestAdapter) <> D3DCREATE_PUREDEVICE Then
                BetterFlag = True
            ElseIf cRenderer(I) = D3DCREATE_HARDWARE_VERTEXPROCESSING And cRenderer(BestAdapter) = D3DCREATE_SOFTWARE_VERTEXPROCESSING Then
                BetterFlag = True
            Else
                If cLargeMode(I).Width * cLargeMode(I).Height > cLargeMode(BestAdapter).Width * cLargeMode(BestAdapter).Height Then
                    BetterFlag = True
                Else
                    If LargerBPP(cLargeMode(I), cLargeMode(BestAdapter)) Then
                        BetterFlag = True
                    Else
                    End If
                End If
            End If
        End If
        If BetterFlag Then BestAdapter = I
    Next I
    
    GetBest3DAdapter = BestAdapter
End Function
 
 
Function LargerBPP(ByRef This As D3DDISPLAYMODE, ByRef Last As D3DDISPLAYMODE) As Boolean
Dim ThisBPP As Long
Dim LastBPP As Long
    
    If This.Format = D3DFMT_A8R8G8B8 Or This.Format = D3DFMT_R8G8B8 Or This.Format = D3DFMT_X8R8G8B8 Then ThisBPP = 32 Else ThisBPP = 16
    If Last.Format = D3DFMT_A8R8G8B8 Or Last.Format = D3DFMT_R8G8B8 Or Last.Format = D3DFMT_X8R8G8B8 Then LastBPP = 32 Else LastBPP = 16
    If ThisBPP >= LastBPP Then LargerBPP = True
 
End Function
 
Public Sub Render()
 
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HFFCC00, 1#, 0
D3DDevice.BeginScene
'<------------------
 
'<------------------
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
 
Function GetFullScreen(W As Long, H As Long, B As Long, Adapter As Long) As D3DPRESENT_PARAMETERS
Dim D3DWindow As D3DPRESENT_PARAMETERS
Dim DispMode As D3DDISPLAYMODE
 
    D3D.GetAdapterDisplayMode BestAdapter, DispMode
 
    D3DWindow.hDeviceWindow = View.hWnd
    
    If B = 32 Then D3DWindow.BackBufferFormat = D3DFMT_A8R8G8B8
    If B = 24 Then D3DWindow.BackBufferFormat = D3DFMT_R8G8B8
    If B = 16 Then D3DWindow.BackBufferFormat = D3DFMT_R5G6B5
    If B = 8 Then D3DWindow.BackBufferFormat = D3DFMT_R3G3B2
    If B <> 8 And B <> 16 And B <> 24 And B <> 32 Then D3DWindow.BackBufferFormat = D3DFMT_R8G8B8
    
    D3DWindow.BackBufferWidth = W
    D3DWindow.BackBufferHeight = H
    
    If D3D.CheckDeviceFormat(Adapter, RetLayer(Adapter), DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D32) = D3D_OK Then
      D3DWindow.AutoDepthStencilFormat = D3DFMT_D32
      D3DWindow.EnableAutoDepthStencil = 1
    Else
    
      If D3D.CheckDeviceFormat(Adapter, RetLayer(Adapter), DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D24X8) = D3D_OK Then
        D3DWindow.AutoDepthStencilFormat = D3DFMT_D24X8
        D3DWindow.EnableAutoDepthStencil = 1
      Else
        If D3D.CheckDeviceFormat(Adapter, RetLayer(Adapter), DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
          D3DWindow.AutoDepthStencilFormat = D3DFMT_D16
          D3DWindow.EnableAutoDepthStencil = 1
        Else
          D3DWindow.EnableAutoDepthStencil = 0
        End If
      End If
    End If
    
    D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
    D3DWindow.BackBufferCount = 1
    
    GetFullScreen = D3DWindow
End Function

Edited for Miscellaneous VB Errors
Edited for Errors and New Function
Edited for Serious Errors

It all works now, except it sometimes says that you have PUREDEVICE when you really don't. I've edited that part out, maybe someone can find a fix.

[DigitalMyth]

Anyone know the answer to this fake PUREDEVICE detection, i have the same problem with my DX project?

If you run this code on a Mid-High Geforce4 Cards and the low FX cards it detects PURE but PURE isn't supported.

Thanks
Digi