Необычная ошибка при вызове SetRenderTarget в DX8.

[Mikle]

[Правка]
Одна из поднимаемых тут проблем была быстро решена, поэтому я исправил название темы так, чтобы он отражал решаемый в данный момент вопрос. Актуально начинать читать с восьмого поста.
[/Правка]

Надеюсь, что вопрос подойдет под новый раздел
При попытке использование D3DX из DX8 в VB5 выводится сообщение об ошибке, Direct3D без использования D3DX работает. Фатально ли это? А то хочется иногда заюзать VB5 Control Creation, как бесплатную версию

[AjaxVS]

Очень интересно.. А почему же у меня буквально пол-года назад, когда я кодил на VB5 все отлично работало с DirectX8, в т.ч. и D3D?

А какая хоть ошибка?

[Mikle]

AjaxVS
Я же написал - не работает именно D3DX, D3D работает.
Ошибка - Object Variable or With Block not set.

[RayShade]

Хм... Текст ошибки как то наводит на мысли что вопрос не по адресу тут

[Mikle]

RayShade
Я понимаю, что обозначает эта ошибка, дело не в этом. Программа с тем же текстом на VB6 работает, а на VB5 сообщает об ошибке. Объявлены те же переменные, в списке References то же самое.

Я аж засомневался, эту ли конкретно ошибку выдает VB5, дома посмотрю еще раз.

[Valenok]

Синтаксис языка разве не был немного изменён?

[Хакер]

Допустим даже если и был иземенён синтаксис, хотя сомневаюсь, что что-то в нём изменилось. Как от этого изменилась работоспособность подключенной библиотеки?

[Mikle]

Все оказалось проще.
Переустановка VB5 решила проблему, до переустановки неработал только D3DX. Так что зря я напряг высокое общество таким пустяком .
Но у меня была еще одна родственная проблема.
Вот простейший код, использующий рендер в текстуру:

Код: Выделить всё

Option Explicit

Dim dx As New DirectX8
Dim d3d As Direct3D8
Dim d3dDevice As Direct3DDevice8

Dim MainC As Direct3DSurface8
Dim TexRT As Direct3DTexture8
Dim NewC As Direct3DSurface8

Dim Running As Boolean

Private Sub InitD3D()
Dim DispMode As D3DDISPLAYMODE
Dim d3dpp As D3DPRESENT_PARAMETERS
  Set d3d = dx.Direct3DCreate
  d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode

  d3dpp.Windowed = True
  d3dpp.SwapEffect = D3DSWAPEFFECT_DISCARD
  d3dpp.BackBufferFormat = DispMode.Format

  Set d3dDevice = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
  Set MainC = d3dDevice.GetRenderTarget

  Set TexRT = d3dDevice.CreateTexture(128, 128, 1, D3DUSAGE_RENDERTARGET, D3DFMT_R5G6B5, D3DPOOL_DEFAULT)
  Set NewC = TexRT.GetSurfaceLevel(0)
End Sub

Private Sub Render()
  d3dDevice.SetRenderTarget NewC, Nothing, 0
  d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0

  d3dDevice.SetRenderTarget MainC, Nothing, 0
  d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
  d3dDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

Private Sub Form_Load()
'  On Local Error Resume Next
  Me.Show
  InitD3D
  Running = True
  Do While DoEvents
    Render
  Loop
  Set MainC = Nothing
  Set NewC = Nothing
  Set TexRT = Nothing
  Set d3dDevice = Nothing
  Set d3d = Nothing
  Set dx = Nothing
End Sub


Он работает в среде VB, работает, если скомпилировать в P-code, но не работает в Native Code. Иногда выдается ошибка "Object Variable or With Block not set", но чаще просто "Программа выполнила недопустимую операцию..."
Ошибка явно происходит в процедуре Render, по крайней мере если ее заремить - все работает. Но введение "On Local Error Resume Next" в эту процедуру не спасает, зато спасает, если ввести это в Form_Load, где ошибки быть просто не может.

[Mikle]

Код: Выделить всё

Option Explicit

Dim dx As New DirectX8
Dim d3d As Direct3D8
Dim d3dDevice As Direct3DDevice8

Dim MainC As Direct3DSurface8
Dim TexRT As Direct3DTexture8
Dim NewC As Direct3DSurface8

Private Sub InitD3D()
Dim DispMode As D3DDISPLAYMODE
Dim d3dpp As D3DPRESENT_PARAMETERS
  Set d3d = dx.Direct3DCreate
  d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode

  d3dpp.Windowed = True
  d3dpp.SwapEffect = D3DSWAPEFFECT_DISCARD
  d3dpp.BackBufferFormat = DispMode.Format

  Set d3dDevice = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
  Set MainC = d3dDevice.GetRenderTarget

  Set TexRT = d3dDevice.CreateTexture(128, 128, 1, D3DUSAGE_RENDERTARGET, D3DFMT_R5G6B5, D3DPOOL_DEFAULT)
  Set NewC = TexRT.GetSurfaceLevel(0)
End Sub

Private Sub Form_Load()
  Me.Show
  InitD3D
  Do While DoEvents
    d3dDevice.SetRenderTarget NewC, Nothing, 0
    d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
 
    d3dDevice.SetRenderTarget MainC, Nothing, 0
    d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
    d3dDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
  Loop
  Set MainC = Nothing
  Set NewC = Nothing
  Set TexRT = Nothing
  Set d3dDevice = Nothing
  Set d3d = Nothing
  Set dx = Nothing
End Sub


Я ничего не изменил, только вместо вызова процедуры Render подставил ее содержимое - и все работает.
Народ, помогите разобраться с ситуацией. Очевидно, что при вызове d3dDevice.SetRenderTarget происходит что-то некорректное, причем оно дает ошибку не в текущей процедуре, а уровнем выше, причем только в Native Code. Во втором примере уровня "выше" нет - и не стало ошибки...

[Vovik]

Самое интересное, что так тоже слетает:

Код: Выделить всё

Private Sub Form_Load()
  On Error GoTo ErrLabel
  Me.Show
  InitD3D
  Running = True
  Do While DoEvents
    Render
  Loop
  Set MainC = Nothing
  Set NewC = Nothing
  Set TexRT = Nothing
  Set d3dDevice = Nothing
  Set d3d = Nothing
  Set dx = Nothing
Exit Sub

ErrLabel:
MsgBox Err.Description
End Sub

[alibek]

Вырезать 2...7 посты?

[Vovik]

Короче старая песня о главном... Майкл, помнится ты говорил, что в библе можно сделать одну приватную функцию, где вызывается SetRenderTarget и public функцию, в которой стоит on error и вызывается та самая приватная. Печально то, что этот ход не спасает ситуацию. Помогает on error только в самой программе, причем не важно его расположение. Мне понравилось ставить его в конце цикла и ошибку не выдало. Т.е. первый (или несколько первых) проход(ов) рендерится без ошибки!!! Как можно обмануть эту заразу? Не указывать же в сдк, что при использовании рендера в текстуру вам нужно обязательно прописать строчку On Local Error Resume Next

[Vovik]

Майкл!!!!! Сделал такой эксперимент:

Код: Выделить всё

Option Explicit

Dim dx As New DirectX8
Dim d3d As Direct3D8
Dim d3dDevice As Direct3DDevice8

Dim MainC As Direct3DSurface8
Dim TexRT As Direct3DTexture8
Dim NewC As Direct3DSurface8

Dim Running As Boolean

Private Sub InitD3D()
Dim DispMode As D3DDISPLAYMODE
Dim d3dpp As D3DPRESENT_PARAMETERS
  Set d3d = dx.Direct3DCreate
  d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode

  d3dpp.Windowed = True
  d3dpp.SwapEffect = D3DSWAPEFFECT_DISCARD
  d3dpp.BackBufferFormat = DispMode.Format

  Set d3dDevice = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)
  Set MainC = d3dDevice.GetRenderTarget

  Set TexRT = d3dDevice.CreateTexture(128, 128, 1, D3DUSAGE_RENDERTARGET, D3DFMT_R5G6B5, D3DPOOL_DEFAULT)
  Set NewC = TexRT.GetSurfaceLevel(0)
End Sub

Private Sub Render()
  MsgBox "5"
  d3dDevice.SetRenderTarget MainC, Nothing, 0
 
  MsgBox "6"
  d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
 
  MsgBox "7"
  d3dDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
 
  MsgBox "8"
End Sub

Private Sub Form_Load()
' On Local Error Resume Next
  Me.Show
  InitD3D
  Running = True
 
  MsgBox "1"
  Do While DoEvents
   
    MsgBox "2"
    d3dDevice.SetRenderTarget NewC, Nothing, 0
   
    MsgBox "3"
    d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1, 0
   
    MsgBox "4"

    Render
    MsgBox "9"
  Loop
  Set MainC = Nothing
  Set NewC = Nothing
  Set TexRT = Nothing
  Set d3dDevice = Nothing
  Set d3d = Nothing
  Set dx = Nothing
End Sub

После запуска exe первый проход действительно не дает ошибки.

[Mikle]

Как можно обмануть эту заразу?

Переходи уже на девятку, эта ошибка скрыта в недрах dx8vb.dll.

[Vovik]

Как можно обмануть эту заразу?

Переходи уже на девятку, эта ошибка скрыта в недрах dx8vb.dll.

Докопался я до истины . Это не дерект виноват. Просто нужно использовать D3DXRenderToSurface. Если кому интересно могу выложить пример.

[Mikle]

Это не дерект виноват. Просто нужно использовать D3DXRenderToSurface.

Виноват, естественно, не директ, а его порт, зашитый в dx8vb.dll. Функция D3DXRenderToSurface портирована без ошибок, но это ещё не значит, что более низкоуровневая SetRenderTarget не обязана корректно работать.

[Vovik]

Это не дерект виноват. Просто нужно использовать D3DXRenderToSurface.

Виноват, естественно, не директ, а его порт, зашитый в dx8vb.dll. Функция D3DXRenderToSurface портирована без ошибок, но это ещё не значит, что более низкоуровневая SetRenderTarget не обязана корректно работать.

Видишь, только она работает корректно.

[Mikle]

Видишь, только она работает корректно.

Да, для тех, кто хочет продолжать использовать DX8 под VB6 - это вариант.

[Vovik]

Видишь, только она работает корректно.

Да, для тех, кто хочет продолжать использовать DX8 под VB6 - это вариант.

Хотелось бы DX9 под VB6, но толкового враппера до сих пор нет...

[Mikle]

Враппера нет, есть мой порт.