[KoZ]MatthewPe2 Posted November 10, 2005 Here I will post any new code in BuilderX which you can use for the next version of DB mod3DMode : RunTextureSelect (Fixes missing flat/texture in 3D mode)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 0 Share this post Link to post
[KoZ]MatthewPe2 Posted November 10, 2005 frmTextureBrowse : Initialize (Fixes missing textures in 2D mode)Public Sub Initialize(ByVal browseflats As Boolean) Dim useditems As New Dictionary Dim Keys As Variant Dim starti As Long Dim i As Long Dim ScrollMax As Long 'None selected selectedindex = -1 'Check if using flats or textures If (browseflats) Then 'Set information for Flats Set collection = flats numitems = collection.Count Caption = "Select Flat" lblViewSort.Caption = "Viewing used flats only. Press TAB to view all flats." Else 'Set information for Textures Set collection = textures numitems = collection.Count + 1 '1 extra for the - Caption = "Select Texture" lblViewSort.Caption = "Viewing used textures only. Press TAB to view all textures." End If 'Check if we are allowed to do subclassing If (CommandSwitch("-nosubclass") = False) Then 'Keep original messages handler OriginalMessageHandler = GetWindowLong(Me.hWnd, GWL_WNDPROC) 'Set our own messages handler SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf TextureMessageHandler End If On Error Resume Next 'Get the key names Keys = collection.Keys 'Allocate memory for string names ReDim itemnames(0 To numitems - 1) 'First texture is nothing If (browseflats = False) Then itemnames(0) = "-" starti = 1 Else starti = 0 End If 'Make string array from names For i = starti To numitems - 1 itemnames(i) = Keys(i - starti) Next i 'Check if we should select used names from sidedefs (textures) If (browseflats = False) Or (Val(Config("mixresources")) = vbChecked) Then 'Go for all sidedefs For i = 0 To numsidedefs - 1 If (useditems.Exists(sidedefs(i).Upper) = False) Then If (collection.Exists(sidedefs(i).Upper)) Then useditems.Add sidedefs(i).Upper, 1 If (useditems.Exists(sidedefs(i).Middle) = False) Then If (collection.Exists(sidedefs(i).Middle)) Then useditems.Add sidedefs(i).Middle, 1 If (useditems.Exists(sidedefs(i).Lower) = False) Then If (collection.Exists(sidedefs(i).Lower)) Then useditems.Add sidedefs(i).Lower, 1 Next i End If 'Check if we should select used names from sectors (flats) If (browseflats = True) Or (Val(Config("mixresources")) = vbChecked) Then 'Go for all sector For i = 0 To numsectors - 1 If (useditems.Exists(sectors(i).tfloor) = False) Then If (collection.Exists(sectors(i).tfloor)) Then useditems.Add sectors(i).tfloor, 1 If (useditems.Exists(sectors(i).tceiling) = False) Then If (collection.Exists(sectors(i).tceiling)) Then useditems.Add sectors(i).tceiling, 1 Next i End If 'Sort used items Set useditems = SortDictionary(useditems) 'When using textures, add 1 for the - If (browseflats) Then numuseditems = useditems.Count Else numuseditems = useditems.Count + 1 'Allocate memory for string names ReDim useditemnames(0 To numuseditems - 1) Keys = useditems.Keys 'First texture is nothing If (browseflats = False) Then useditemnames(0) = "-" starti = 1 Else starti = 0 End If 'Make string array from texture names For i = starti To numuseditems - 1 'Add to array useditemnames(i) = Keys(i - starti) Next i 'Set the current collection curitemnames() = useditemnames() curnumitems = numuseditems 'Resize list picList.Width = ScaleWidth - picList.left * 2 picList.Height = ScaleHeight - picBottom.Height - picList.top 'Reposition scrollbar scrScroll.left = picList.ScaleWidth - scrScroll.Width scrScroll.Height = picList.ScaleHeight 'Rearrange controls ArrangeBoxes 'Set the scrollbar max ScrollMax = (curnumitems \ cols) + 1 - Rows If (ScrollMax < 0) Then ScrollMax = 0 scrScroll.Max = ScrollMax scrScroll.LargeChange = Rows End Sub 0 Share this post Link to post
CodeImp Posted November 10, 2005 4 pages of code isn't really telling me what the problem is and im not going to copy/paste that into Doom Builder blindly. It would help if you could explain the bugs you have found and tell me what code lines cause the problem for each bug. 0 Share this post Link to post
Xtife Posted November 11, 2005 would this fix the subscript out of range bug that happeneds randomly aswell? i dont think that was fixed in builderX, except for when it happned with missing textures 0 Share this post Link to post
[KoZ]MatthewPe2 Posted November 24, 2005 In Progress: Wad Specific Text Lump Editing (like ANIMDEFS, MAPINFO, TERRAIN etc) This is a primitive lump editor and will probably eventually become the resolution for the dreaded "OMG OMG CODEIMP GIVE LUMP EDITING! OMG OMG" What is BuilderX?Doomguy0505/MatthewPe2 said:Download it here: http://members.lycos.co.uk/doomguy0505/builderx Note: I'm still uploading it so it may be corrupted, sorry about this * Bugs Fixed * These are all updated to the LATEST version, so don't complain about a remaining bug to me unless you have the latest o Fixed the bad patch and invalid number error o Fixed shitty missing texture error o No patch error (I forgot to list it last release) * Releases * Format: DD MM YY 29/8/05 - Builer_67x.zip 30/8/05 - Builder_1-67x.zip 0 Share this post Link to post