Jump to content
Search In
  • More options...
Find results that contain...
Find results in...
[KoZ]MatthewPe2

Texture Error Fix For 3D Mode

Recommended Posts

RunTextureSelect in mod3DMode

Private Function RunTextureSelect(ByVal CurrentTexture As String, ByVal UseFlats As Boolean) As String
     'On Error GoTo Leave3DMode
     On Error Resume Next
     Dim ErrNumber As Long
     Dim ErrDesc As String
     Dim TextRect As SRECT
     Dim MousePoint As POINT
     Dim LastCursorUpdate As Long
     
     'Get mouse coords
     GetCursorPos MousePoint
     
     'Keep coords
     TLastX = MousePoint.x
     TLastY = MousePoint.y
     
     'Determine area
     With TextRect
          .left = 0
          .top = 0.9
          .right = 0.6
          .bottom = 1
     End With
     
     'Make the text
     Set r_texdesc = VertexBufferFromText(TEXTURE_DESC, TextRect, ALIGN_RIGHT, ALIGN_MIDDLE, TEXT_C1, TEXT_C2, TEXT_C3, TEXT_C4, TEXT_SIZE)
     r_numtexdescfaces = Len(TEXTURE_DESC) * 4 - 2
     
     'Initiate defaults
     InitTextureSelect CurrentTexture, UseFlats
     
     'Current texture
     SelectedName = CurrentTexture
     CreateSelectedTextureText
     
     'We are now selecting a texture/flat
     TextureSelecting = True
     ThingSelecting = False
     
     'Initiate the textures field
     CreateTexturePreviews
     
     Do
          'Calculate time
          CurrentTime = timeExactTime
          FrameTime = CurrentTime - LastTime
          LastTime = CurrentTime
          
          'Poll the mouse
          PollMouse
          
          'Mouse events can do anything, also terminating 3d mode
          If Not Running3D Then Exit Do
          
          'Check for cursor update
          If ((LastCursorUpdate + CURSOR_FLASH_INTERVAL) < CurrentTime) Then
               
               'Change the cursor
               ShowTextCursor = Not ShowTextCursor
               
               'Recreate the text buffer
               CreateSelectedTextureText
               
               'Keep the time
               LastCursorUpdate = CurrentTime
          End If
          
          '===== Start scene
          D3DD.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, Val(Config("palette")("CLR_BACKGROUND")), 1, 0
          D3DD.BeginScene
          
          'Apply Matrices
          D3DD.SetTransform D3DTS_PROJECTION, matrixProject
          D3DD.SetTransform D3DTS_VIEW, matrixView
          D3DD.SetTransform D3DTS_WORLD, matrixWorld
          
          'Beginning settings
          D3DD.SetRenderState D3DRS_ALPHABLENDENABLE, 0
          D3DD.SetRenderState D3DRS_LIGHTING, 0
          D3DD.SetRenderState D3DRS_CULLMODE, D3DCULL_CW
          
          'Texture filtering as configured
          SetTextureFilters False
          
          'Render selection background
          RenderSelection
          
          'Render texture previews
          RenderTexturePreviews
          
          'Bilinear texture filtering
          SetTextureFilters True
          
          'Render texts
          CreateSelectedTextureText
          RenderTextureTexts
          
          'Texture filtering as configured
          SetTextureFilters False
          
          'Render the mouse
          RenderMouse
          
          
          '===== End scene
          D3DD.EndScene
          
          '===== Present scene
          D3DD.Present ByVal 0, ByVal 0, 0, ByVal 0
          
          'Process messages
          DoEvents
          
          'Delay frames
          If (DelayVideoFrames) Then Sleep 50 Else Sleep 10
          
          'Next fame input will be done again
          IgnoreInput = False
          
     'Continue until 'dialog' closed
     Loop While TextureSelecting And Running3D
     
     
Leave3DMode:
     
     'Check if 3D Mode was not terminated
     If (Running3D = True) Then
          
          'Check if not quit nicely
          If (TextureSelecting = True) Or (Err.number <> 0) Then
               
               'Keep error
               ErrNumber = Err.number
               ErrDesc = Err.Description
               
               'Clean up directx mode
               Running3D = False
               TextureSelecting = False
               CleanUp3DMode
               
               'Display error if not device lost error
               If (ErrNumber <> -2005530520) Then MsgBox "Error " & ErrNumber & " in RunTextureSelect: " & ErrDesc, vbCritical
               
               'Yes, cancel this
               TextureSelectCancelled = True
          End If
          
          'Check if cancelled
          If TextureSelectCancelled Then
               
               'Keep original texture
               RunTextureSelect = CurrentTexture
          Else
               
               'Check if we should get complete texture name
               If (Val(Config("autocompletetex")) <> 0) And (TextureSelectedIndex >= 0) Then
                    
                    'Return new texture
                    RunTextureSelect = curitemnames(TextureSelectedIndex)
               Else
                    
                    'Use typed name
                    RunTextureSelect = SelectedName
               End If
          End If
     Else
          
          'Clear errors
          Err.Clear
          
          'Keep original texture
          RunTextureSelect = CurrentTexture
     End If
     
     'Clean up arrays
     Erase itemnames()
     Erase useditemnames()
     Erase curitemnames()
     Set collection = Nothing
End Function
The selection might show the textures instead of flats until you click tab but it's much better than losing your hard work.

Share this post


Link to post

Please sign in to comment

You will be able to leave a comment after signing in



Sign In Now
×