.net - DirectX for Managed Code (VB.Net) で DeviceLostException から回復する方法は?

Question

注: (マネージ コードの DX が非推奨であることは知っています。時間に余裕ができたら、SlimDX でコードを書き直す予定です。) ほとんどの DX アプリケーションとは異なり、フレームを継続的にレンダリングするのではなく、画面上のコンテンツを変更する必要がある場合にのみレンダリングします。これにより、DeviceLostExceptions を処理するためのガイドに従うのが少し難しくなります。Nvidia の 3D Vision テクノロジを使用して立体画像を表示するプログラムを作成しています。私の表示クラスは、フルスクリーンに拡張されたボーダーレス ウィンドウ フォーム クラスです。基本フォームと DirectX デバイスを設定する BaseStimulusDisplay という基本クラスがあり、それを継承してステレオ イメージの表示に使用する StereoStimulusDisplay オブジェクトを作成します。(これは、プログラムのさまざまな側面に対応する他のタイプのディスプレイがあるためです。) クラスが機能する方法は、オブジェクトの 2 つのリスト (stereoObjects と singleEyeObjects) があることです。これらは、基本的に、いくつかの DX サーフェスといくつかの位置を含むオブジェクトですinfo を使用して、サーフェスを画面上のどこに描画するかを決定します。オブジェクトを画面に表示したいときは、RenderScene メソッドを呼び出します。このメソッドは、オブジェクトのリスト内の各オブジェクトをループし、StretchRectangle メソッドを使用してオブジェクト サーフェスをバックバッファに描画してから、preset() を呼び出します。DeviceLostException を試して処理するために、Render Scene メソッドの最後にある device.Present() を次のような try ブロックに入れました。) クラスが機能する方法は、オブジェクトの 2 つのリスト (stereoObjects と singleEyeObjects) を持っていることです。これらは基本的に、いくつかの DX サーフェスと、サーフェスを画面に描画する場所を決定するための位置情報を含むオブジェクトです。オブジェクトを画面に表示したいときは、RenderScene メソッドを呼び出します。このメソッドは、オブジェクトのリスト内の各オブジェクトをループし、StretchRectangle メソッドを使用してオブジェクト サーフェスをバックバッファに描画してから、preset() を呼び出します。DeviceLostException を試して処理するために、Render Scene メソッドの最後にある device.Present() を次のような try ブロックに入れました。) クラスが機能する方法は、オブジェクトの 2 つのリスト (stereoObjects と singleEyeObjects) を持っていることです。これらは基本的に、いくつかの DX サーフェスと、サーフェスを画面に描画する場所を決定するための位置情報を含むオブジェクトです。オブジェクトを画面に表示したいときは、RenderScene メソッドを呼び出します。このメソッドは、オブジェクトのリスト内の各オブジェクトをループし、StretchRectangle メソッドを使用してオブジェクト サーフェスをバックバッファに描画してから、preset() を呼び出します。DeviceLostException を試して処理するために、Render Scene メソッドの最後にある device.Present() を次のような try ブロックに入れました。オブジェクトを画面に表示したいときは、RenderScene メソッドを呼び出します。このメソッドは、オブジェクトのリスト内の各オブジェクトをループし、StretchRectangle メソッドを使用してオブジェクト サーフェスをバックバッファに描画してから、preset() を呼び出します。DeviceLostException を試して処理するために、Render Scene メソッドの最後にある device.Present() を次のような try ブロックに入れました。オブジェクトを画面に表示したいときは、RenderScene メソッドを呼び出します。このメソッドは、オブジェクトのリスト内の各オブジェクトをループし、StretchRectangle メソッドを使用してオブジェクト サーフェスをバックバッファに描画してから、preset() を呼び出します。DeviceLostException を試して処理するために、Render Scene メソッドの最後にある device.Present() を次のような try ブロックに入れました。

    Try
        Me._device.Present()
    Catch ex As DeviceLostException
        'Indicate that the device has been lost
        deviceIsLost = True
        'Send a message to the debug output that the device was lost
        Debug.WriteLine("Device was lost... Attempting to recover device")
        waitForDeviceRecovery()
        renderScene()
    End Try

これがwaitForDeviceRecoveryです。device.Reset() を呼び出す前に、ビデオ メモリを使用するすべてのオブジェクトを確実に破棄し、呼び出し後にサーフェスを再割り当てします。

Public Overridable Sub waitForDeviceRecovery()
    Do
        Try
            _device.TestCooperativeLevel()
        Catch ex As DeviceLostException

        Catch ex2 As DeviceNotResetException
            Try
                For Each Val As StereoObject In stereoObjectList
                    Val.Dispose()
                Next
                For Each Val As SingleEyeImage In singleEyeList
                    Val.Dispose()
                Next

                Me._offScreenSurface.Dispose()
                Me._backBuffer.Dispose()
                Me._blankScreenSurface.Dispose()
                Me._leftEyeSurface.Dispose()
                Me._rightEyeSurface.Dispose()
                Me._backBuffer.Dispose()

                _device.Reset(presentParams)
                deviceIsLost = False

                For Each Val As StereoObject In stereoObjectList
                    Val.loadSurfaces(Val.objName)
                Next
                For Each Val As SingleEyeImage In singleEyeList
                    Val.loadSurface(Val.objName)
                Next
                createSurfaces()

                'Send a message to debug out put that the device was recovered
                Debug.WriteLine("The device was successfully recoverd")
            Catch ex As DeviceLostException

            End Try
        End Try
    Loop Until deviceIsLost = False
End Sub

ここでコードを実行し、Alt-Tab を押して開いているプログラムを循環し、DX アプリに戻ると、renderScene メソッドの次の行でコードがクラッシュし、InvalidCallException が発生しました。

  Me._device.ColorFill(Me._leftEyeSurface, New Rectangle(0, 0, Me._size.Width, Me._size.Height), color)

また、別のプログラムにAlt-Tabを押した場合（アプリのリストをすべて循環してアプリに戻すだけではありません）、アプリを元に戻そうとします。プログラムが元に戻ることはなく、waitForDeviceRecovery メソッドの do ループでスタックするだけです。これは、device.TestCooperativeLevel() 呼び出しが DeviceLostException をスローし続け、DeviceNotResetException をスローしないことを意味します。以下の両方の表示クラスの完全なコードを追加しています。

以下は、基本刺激表示のコードです。

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.IO

Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.Direct3D.PresentParameters

Public MustInherit Class BaseStimulusDisplay

Public displaySettings As DisplaySettings
Public _size As Rectangle                                          'Size of screen
Public _device As Device                                           'DX device object to interface with graphics card
Protected _offScreenSurface As Surface                                'Surface on which to draw the SteroScreen images
Protected _blankScreenSurface As Surface                              'Surface of all background color
Protected _backBuffer As Surface                                      'The DX backbuffer
Protected _adapter As Integer = Direct3D.Manager.Adapters.Default.Adapter
Protected presentParams As PresentParameters
Protected deviceIsLost As Boolean = False

Public Sub New(ByVal displaySettings As DisplaySettings)
    'Make windows happy
    Me.components = Nothing
    Me.InitializeComponent()

    Me.displaySettings = displaySettings
    Me._size = New Rectangle(0, 0, Me.displaySettings.xResolution, Me.displaySettings.yResolution)
    MyBase.SetStyle((ControlStyles.AllPaintingInWmPaint Or ControlStyles.Opaque Or ControlStyles.ContainerControl), True)
    Me.InitializeDevice()   'Set the device parameters and create the device

    Invalidate()
End Sub

Public Overridable Sub InitializeDevice()
    presentParams = New PresentParameters
    presentParams.Windowed = False
    presentParams.BackBufferFormat = Format.X8R8G8B8
    presentParams.BackBufferWidth = Me._size.Width
    presentParams.BackBufferHeight = Me._size.Height
    presentParams.BackBufferCount = 1
    presentParams.SwapEffect = Direct3D.SwapEffect.Discard
    presentParams.PresentationInterval = PresentInterval.One
    Me._device = New Device(_adapter, DeviceType.Hardware, CType(Me, Control), CreateFlags.HardwareVertexProcessing, New PresentParameters() {presentParams})
End Sub

Public Overridable Sub createSurfaces()
    Me._offScreenSurface = Me._device.CreateOffscreenPlainSurface(Me._size.Width, Me._size.Height, Format.X8R8G8B8, Pool.Default)
    Me._backBuffer = Me._device.CreateOffscreenPlainSurface(Me._size.Width, Me._size.Height, Format.X8R8G8B8, Pool.Default)
    Me._blankScreenSurface = Me._device.CreateOffscreenPlainSurface(Me._size.Width, Me._size.Height, Format.X8R8G8B8, Pool.Default)
End Sub

Public Overridable Overloads Sub Dispose()
    Me._offScreenSurface.Dispose()
    Me._backBuffer.Dispose()
    Me._blankScreenSurface.Dispose()

    MyBase.Dispose()
End Sub

Public MustOverride Sub renderScene()

Public MustOverride Sub closeDisplay()

End Class

以下は、StereoStimulsDisplay と StereoObject および SingleEyeObject のコードです。

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.IO

Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.Direct3D.PresentParameters

Public Class StereoStimulusDisplay
Private Const colorFormat As Format = Format.A8B8G8R8           'The sufrace color format to use
Private Const poolType As Pool = Pool.Default                   'The sufrace memory pool type NOT SURE WHAT THIS IS FOR

Dim stereoObjectList As List(Of StereoObject)
Dim singleEyeList As List(Of SingleEyeImage)

Dim _leftEyeSurface As Surface
Dim _rightEyeSurface As Surface

Public Sub New(ByVal displaySettings As DisplaySettings)
    MyBase.New(displaySettings)
    InitializeComponent()

    stereoObjectList = New List(Of StereoObject)
    singleEyeList = New List(Of SingleEyeImage)

    createSurfaces()

    renderScene()   'Double render call is a hack to make sure the stereo display gets triggerd
    renderScene()
End Sub

Public Sub addStereoObject(ByRef sObject As StereoObject)
    stereoObjectList.Add(sObject)
End Sub

Public Sub addSingleEyeObject(ByRef sObject As SingleEyeImage)
    singleEyeList.Add(sObject)
End Sub

Public Function removeStereoObject(ByRef sObject As StereoObject)
    sObject.Dispose()
    Return stereoObjectList.Remove(sObject)
End Function

Public Function removeSingleEyeObject(ByRef sObject As SingleEyeImage)
    sObject.Dispose()
    Return singleEyeList.Remove(sObject)
End Function

Public Overrides Sub createSurfaces()
    MyBase.createSurfaces()
    Me._offScreenSurface = Me._device.CreateOffscreenPlainSurface((Me._size.Width * 2), (Me._size.Height + 1), Format.A8R8G8B8, Pool.Default)
    Me._leftEyeSurface = Me._device.CreateOffscreenPlainSurface((Me._size.Width), (Me._size.Height), Format.A8R8G8B8, Pool.Default)
    Me._rightEyeSurface = Me._device.CreateOffscreenPlainSurface((Me._size.Width), (Me._size.Height), Format.A8R8G8B8, Pool.Default)
    Me._blankScreenSurface = Me._device.CreateOffscreenPlainSurface((Me._size.Width * 2), (Me._size.Height + 1), Format.A8R8G8B8, Pool.Default)
End Sub

Public Sub displayBlankScene(ByVal color As Color)
    'Erase the lase frame from surfaces
    Me._device.ColorFill(Me._leftEyeSurface, New Rectangle(0, 0, Me._size.Width, Me._size.Height), color)
    Me._device.ColorFill(Me._rightEyeSurface, New Rectangle(0, 0, Me._size.Width, Me._size.Height), color)

    Dim destRect As New Rectangle(0, 0, Me._size.Width, Me._size.Height)

    'If Not useData Then
    Me._device.StretchRectangle(Me._leftEyeSurface, CType(Me._size, Rectangle), Me._offScreenSurface, CType(destRect, Rectangle), TextureFilter.None)
    destRect.X = Me._size.Width
    Me._device.StretchRectangle(Me._rightEyeSurface, CType(Me._size, Rectangle), Me._offScreenSurface, CType(destRect, Rectangle), TextureFilter.None)
    'End If
    Dim gStream As GraphicsStream = Me._offScreenSurface.LockRectangle(LockFlags.None)
    Dim data As Byte() = New Byte() {78, 86, 51, 68, 0, 15, 0, 0, 56, 4, 0, 0, 32, 0, 0, 0, 2, 0, 0, 0}
    gStream.Seek(CLng((((Me._size.Width * 2) * Me._size.Height) * 4)), SeekOrigin.Begin)
    gStream.Write(data, 0, data.Length)
    gStream.Close()
    Me._offScreenSurface.UnlockRectangle()

    Me._device.BeginScene()

    Me._backBuffer = Me._device.GetBackBuffer(0, 0, BackBufferType.Mono)
    Me._device.StretchRectangle(
        Me._offScreenSurface, CType(New Rectangle(0, 0, (Me._size.Width * 2), (Me._size.Height + 1)), Rectangle),
        Me._backBuffer, CType(New Rectangle(0, 0, Me._size.Width, Me._size.Height), Rectangle), TextureFilter.None)
    Me._backBuffer.ReleaseGraphics()
    Me._device.EndScene()

    Try
        Me._device.Present()
    Catch ex As DeviceLostException
        'Indicate that the device has been lost
        deviceIsLost = True

        'Send a message to the debug output that the device was lost
        Debug.WriteLine("Device was lost... Attempting to recover device")
        waitForDeviceRecovery()
        displayBlankScene(color)
    End Try

    MyBase.Invalidate()
End Sub

Public Overrides Sub renderScene()
    'Erase the last frame from surfaces
    Me._device.ColorFill(Me._leftEyeSurface, New Rectangle(0, 0, Me._size.Width, Me._size.Height), Color.Black)
    Me._device.ColorFill(Me._rightEyeSurface, New Rectangle(0, 0, Me._size.Width, Me._size.Height), Color.Black)

    'Write all steroscopic objects to both eye surfaces
    For Each stereoObj As StereoObject In stereoObjectList
        Me._device.StretchRectangle(stereoObj.leftSurface, CType(stereoObj.leftSourRect, Rectangle), Me._leftEyeSurface, CType(stereoObj.leftDestRec, Rectangle), TextureFilter.None)
        Me._device.StretchRectangle(stereoObj.rightSurface, CType(stereoObj.rightSourRect, Rectangle), Me._rightEyeSurface, CType(stereoObj.rightDestRec, Rectangle), TextureFilter.None)
    Next

    'Write all single eye objects to their proper surface 
    For Each SingleEyeObj In singleEyeList
        If SingleEyeObj.displayEye = SingleEyeImage.EYE.Left Then
            Me._device.StretchRectangle(SingleEyeObj.surface, CType(SingleEyeObj.sourRect, Rectangle), Me._leftEyeSurface, CType(SingleEyeObj.destRec, Rectangle), TextureFilter.None)
        ElseIf SingleEyeObj.displayEye = SingleEyeImage.EYE.Right Then
            Me._device.StretchRectangle(SingleEyeObj.surface, CType(SingleEyeObj.sourRect, Rectangle), Me._rightEyeSurface, CType(SingleEyeObj.destRec, Rectangle), TextureFilter.None)
        ElseIf SingleEyeObj.displayEye = SingleEyeImage.EYE.Both Then
            Me._device.StretchRectangle(SingleEyeObj.surface, CType(SingleEyeObj.sourRect, Rectangle), Me._leftEyeSurface, CType(SingleEyeObj.destRec, Rectangle), TextureFilter.None)
            Me._device.StretchRectangle(SingleEyeObj.surface, CType(SingleEyeObj.sourRect, Rectangle), Me._rightEyeSurface, CType(SingleEyeObj.destRec, Rectangle), TextureFilter.None)
        End If
    Next

    Dim destRect As New Rectangle(0, 0, Me._size.Width, Me._size.Height)

    Me._device.StretchRectangle(Me._leftEyeSurface, CType(Me._size, Rectangle), Me._offScreenSurface, CType(destRect, Rectangle), TextureFilter.None)
    destRect.X = Me._size.Width
    Me._device.StretchRectangle(Me._rightEyeSurface, CType(Me._size, Rectangle), Me._offScreenSurface, CType(destRect, Rectangle), TextureFilter.None)


    Dim gStream As GraphicsStream = Me._offScreenSurface.LockRectangle(LockFlags.None)
    Dim data As Byte() = New Byte() {78, 86, 51, 68, 0, 15, 0, 0, 56, 4, 0, 0, 32, 0, 0, 0, 2, 0, 0, 0}
    gStream.Seek(CLng((((Me._size.Width * 2) * Me._size.Height) * 4)), SeekOrigin.Begin)
    gStream.Write(data, 0, data.Length)
    gStream.Close()
    Me._offScreenSurface.UnlockRectangle()

    Me._device.BeginScene()

    Me._backBuffer = Me._device.GetBackBuffer(0, 0, BackBufferType.Mono)
    Me._device.StretchRectangle(
        Me._offScreenSurface, CType(New Rectangle(0, 0, (Me._size.Width * 2), (Me._size.Height + 1)), Rectangle),
        Me._backBuffer, CType(New Rectangle(0, 0, Me._size.Width, Me._size.Height), Rectangle), TextureFilter.None)
    Me._backBuffer.ReleaseGraphics()
    Me._device.EndScene()

    Try
        Me._device.Present()
    Catch ex As DeviceLostException
        'Indicate that the device has been lost
        deviceIsLost = True
        'Send a message to the debug output that the device was lost
        Debug.WriteLine("Device was lost... Attempting to recover device")
        waitForDeviceRecovery()
        renderScene()
    End Try
    MyBase.Invalidate()

End Sub

Public Overridable Sub waitForDeviceRecovery()
    Do
        Try
            _device.TestCooperativeLevel()
        Catch ex As DeviceLostException

        Catch ex2 As DeviceNotResetException
            Try
                For Each Val As StereoObject In stereoObjectList
                    Val.Dispose()
                Next
                For Each Val As SingleEyeImage In singleEyeList
                    Val.Dispose()
                Next

                Me._offScreenSurface.Dispose()
                Me._backBuffer.Dispose()
                Me._blankScreenSurface.Dispose()
                Me._leftEyeSurface.Dispose()
                Me._rightEyeSurface.Dispose()
                Me._backBuffer.Dispose()

                _device.Reset(presentParams)
                deviceIsLost = False

                For Each Val As StereoObject In stereoObjectList
                    Val.loadSurfaces(Val.objName)
                Next
                For Each Val As SingleEyeImage In singleEyeList
                    Val.loadSurface(Val.objName)
                Next
                createSurfaces()

                'Send a message to debug out put that the device was recovered
                Debug.WriteLine("The device was successfully recoverd")
            Catch ex As DeviceLostException

            End Try
        End Try
    Loop Until deviceIsLost = False
End Sub

Public Overrides Sub closeDisplay()
    For Each val As StereoObject In stereoObjectList
        val.Dispose()
    Next

    For Each val As SingleEyeImage In singleEyeList
        val.Dispose()
    Next

    MyBase.Dispose()
    Dispose()
    Close()
End Sub

Public Shared Function computeDispayableDisparity(ByVal requestedLevel As Double,
                                                  ByVal displaySettings As DisplaySettings,
                                                  ByVal numSubPixelShifts As Integer) As Double
    Dim arcPerSub As Double = displaySettings.arcSecsPerPixel / numSubPixelShifts
    Dim leftOver As Double = requestedLevel Mod arcPerSub
    If leftOver < arcPerSub / 2 Then
        Return requestedLevel - leftOver
    Else
        Return requestedLevel - leftOver + arcPerSub
    End If
End Function
End Class

Public Class StereoObject Public pos As Point Public objName As String Public actualDisparty As Double Public numSubPixelLevels As Integer

Private subPixelSurfaces As Surface()
Private subPixelImages As Image()
Private parentDisplay As StereoStimulusDisplay

Public leftDestRec As Rectangle
Public rightDestRec As Rectangle
Public leftSourRect As Rectangle
Public rightSourRect As Rectangle

Public leftSurface As Surface
Public rightSurface As Surface

Public Sub New(ByVal objName As String, ByVal pos As Point, ByVal disparity As Double, ByVal numSubPixelLevels As Integer, ByRef parentDisplay As StereoStimulusDisplay)
    Me.objName = objName
    Me.pos = pos
    Me.numSubPixelLevels = numSubPixelLevels
    Me.parentDisplay = parentDisplay
    ReDim subPixelSurfaces(numSubPixelLevels - 1)
    ReDim subPixelImages(numSubPixelLevels - 1)

    ' Create and load the surfaces for all of the diffrent sub pixels images
    loadSurfaces(objName)
    Me.actualDisparty = updateDisparity(disparity)
End Sub

Public Function updateDisparity(ByVal newDisparty As Double) As Double
    Dim disparityDirection As Integer, pxlDisparity As Double, halfShift As Double, nPixelShift As Integer, fracDisparity As Double
    Dim nSubPixelShift As Integer, halfSubR As Double, halfSubL As Double, pxlR As Integer, pxlL As Integer, subR As Integer, subL As Integer
    Dim actualDisparity As Double

    'disparityDirection + backward;  - forward(crossed)
    If newDisparty > 0.0 Then
        disparityDirection = 1
    Else
        disparityDirection = -1
        newDisparty *= -1
    End If

    Dim test As Double = Me.parentDisplay.displaySettings.arcSecsPerPixel()
    pxlDisparity = newDisparty * Me.parentDisplay.displaySettings.pixelsPerArcSec()
    halfShift = pxlDisparity / 2.0
    nPixelShift = CType(Math.Truncate(halfShift), Integer)
    fracDisparity = halfShift - nPixelShift
    nSubPixelShift = CType(Math.Round(fracDisparity * 32), Integer)
    halfSubR = nSubPixelShift \ 2
    halfSubL = nSubPixelShift - halfSubR
    pxlR = nPixelShift
    subR = halfSubR
    pxlL = -nPixelShift
    If nSubPixelShift = 0 Then
        subL = 0
    Else
        subL = Me.numSubPixelLevels - halfSubL
        pxlL -= 1
    End If
    If pxlR = 0 And subR = 0 And pxlL = 0 And subL = 0 Then
        subR = 1
    End If
    actualDisparity = Me.parentDisplay.displaySettings.arcSecsPerPixel() * (Math.Abs(pxlL * Me.numSubPixelLevels + subL) + Math.Abs(pxlR * Me.numSubPixelLevels + subR)) / Me.numSubPixelLevels
    If actualDisparity = 0 Then
        subR = 1
        actualDisparity = Me.parentDisplay.displaySettings.arcSecsPerPixel() / Me.numSubPixelLevels
    End If

    If disparityDirection > 0 Then
        Me.leftDestRec = New Rectangle(pos.X + pxlL, pos.Y, subPixelImages(subL).Width, subPixelImages(subL).Height)
        Me.rightDestRec = New Rectangle(pos.X + pxlR, pos.Y, subPixelImages(subR).Width, subPixelImages(subR).Height)
        Me.leftSourRect = New Rectangle(0, 0, subPixelImages(subL).Width, subPixelImages(subL).Height)
        Me.rightSourRect = New Rectangle(0, 0, subPixelImages(subR).Width, subPixelImages(subR).Height)

        Me.leftSurface = subPixelSurfaces(subL)
        Me.rightSurface = subPixelSurfaces(subR)
    Else
        Me.leftDestRec = New Rectangle(pos.X + pxlR, pos.Y, subPixelImages(subR).Width, subPixelImages(subR).Height)
        Me.rightDestRec = New Rectangle(pos.X + pxlL, pos.Y, subPixelImages(subL).Width, subPixelImages(subL).Height)
        Me.rightSourRect = New Rectangle(0, 0, subPixelImages(subL).Width, subPixelImages(subL).Height)
        Me.leftSourRect = New Rectangle(0, 0, subPixelImages(subR).Width, subPixelImages(subR).Height)

        Me.leftSurface = subPixelSurfaces(subR)
        Me.rightSurface = subPixelSurfaces(subL)
    End If

    Return actualDisparity
End Function

Public Sub loadSurfaces(ByVal fileName As String)
    Dim name As String = ""
    For i As Integer = 0 To numSubPixelLevels - 1
        name = Application.StartupPath & "\input\StereoObjectFiles\" & fileName & "\" & fileName & "_" & i.ToString() & ".bmp"
        subPixelImages(i) = Image.FromFile(name)
        subPixelSurfaces(i) = Surface.FromBitmap(parentDisplay._device, CType(DirectCast(subPixelImages(i), Bitmap), Bitmap), Pool.Default)
    Next
End Sub

Public Sub Dispose()
    leftSurface.Dispose()
    rightSurface.Dispose()
    For Each surf As Surface In subPixelSurfaces
        surf.Dispose()
    Next

    For Each img As Image In subPixelImages
        img.Dispose()
    Next
End Sub

Public Sub setPos(ByVal pos As Point)
    Me.pos = pos
    Me.updateDisparity(Me.actualDisparty)
End Sub

Public Sub setToTrueZeroDepth()
    Me.leftDestRec = New Rectangle(pos.X, pos.Y, subPixelImages(0).Width, subPixelImages(0).Height)
    Me.rightDestRec = Me.leftDestRec
    Me.leftSourRect = New Rectangle(0, 0, subPixelImages(0).Width, subPixelImages(0).Height)
    Me.leftSourRect = New Rectangle(0, 0, subPixelImages(0).Width, subPixelImages(0).Height)
    Me.leftSurface = subPixelSurfaces(0)
    Me.rightSurface = subPixelSurfaces(0)
End Sub

クラス終了

Public Class SingleEyeImage Enum EYE As Integer Left = 0 Right = 1 Both = 3 End Enum

Public pos As Point
Public objName As String
Private parentDisplay As StereoStimulusDisplay

Public displayEye As Integer
Public destRec As Rectangle
Public sourRect As Rectangle
Public surface As Surface

Public Sub New(ByVal objName As String, ByVal pos As Point, ByVal eye As EYE, ByRef parentDisplay As StereoStimulusDisplay)
    Me.objName = objName
    Me.pos = pos
    displayEye = eye
    Me.parentDisplay = parentDisplay
    loadSurface(objName)
End Sub

Public Sub loadSurface(ByVal fileName As String)
    'Dim path As String = Application.StartupPath & "\input\SingleEyeObjectFiles\" & fileName & ".bmp"
    Dim path As String = Application.StartupPath & "\input\SingleEyeObjectFiles\" & fileName
    Dim img As Image = Image.FromFile(path)
    surface = surface.FromBitmap(parentDisplay._device, CType(DirectCast(img, Bitmap), Bitmap), Pool.Default)
    sourRect = New Rectangle(0, 0, img.Width, img.Height)
    destRec = New Rectangle(Me.pos.X, Me.pos.Y, img.Width, img.Height)
    img.Dispose()
End Sub

Public Sub setPos(ByVal pos As Point)
    Me.pos = pos
    Me.destRec.X = pos.X
    Me.destRec.Y = pos.Y
End Sub

Public Sub Dispose()
    surface.Dispose()
End Sub

クラス終了