[KoZ]MatthewPe2 Posted October 29, 2005 RunTextureSelect in mod3DModePrivate 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. 0 Share this post Link to post