PureBasic Forums - English

Posted: **Sun Dec 31, 2006 8:34 pm**

This procedure will list all the relevant texture files that a 3d object (3ds or x) uses. The texture files have to be located in the models directory to for this procedure to include them.

It was written to be part of a landscape and object placement editor, so when the scene is packed up, all the textures are included with it.

The method used should be able to search any 3d format has the texture file names intact.

Code: Select all

; List 3D File Textures Procedure
; Written by Michael R. King
; Mike@newrealitygames.co.uk

; This procedure will list all the texture files the object uses providing
; the texture file exists in the directory of the file.
; Only added 3ds and x support at the current moment.


Declare ExamineObject(File$)

Global NewList Texture.s()

F$=OpenFileRequester("Select Model","","*.*",0)

If FileSize(F$)>0

ExamineObject(F$)

Debug "Included Textures;"
ForEach Texture()
Debug Texture()
Next


EndIf





Procedure ExamineObject(File$)
Dir$=GetPathPart(File$)
Ext$=LCase(GetExtensionPart(File$))
Size=FileSize(File$)

NewList Content.s()

ExamineDirectory(0,Dir$,"*.*")
While NextDirectoryEntry(0)<>0
If DirectoryEntryName(0)<>"." And DirectoryEntryName(0)<>".."
AddElement(Content())
Content()=LCase(DirectoryEntryName(0))
EndIf
Wend

Select Ext$

Case "3ds"
  ReadFile(0,File$)
  Repeat
  Line.s=LCase(ReadString(0))
  ForEach Content()
  Criteria.s=Content()
  If FindString(Line.s,Criteria,0)
  Exist=0
  ForEach Texture()
  If Criteria=Texture() : Exist=1 : EndIf
  Next
  If Exist=0
  AddElement(Texture())
  Texture()=Criteria
  EndIf
  EndIf
  Next
  Until Eof(0)
  CloseFile(0)

Case "x"
  ReadFile(0,File$)
  Repeat
  Line.s=LCase(ReadString(0))
  ForEach Content()
  Criteria.s=Content()
  If FindString(Line.s,Criteria,0)
  Exist=0
  ForEach Texture()
  If Criteria=Texture() : Exist=1 : EndIf
  Next
  If Exist=0
  AddElement(Texture())
  Texture()=Criteria
  EndIf
  EndIf
  Next
  Until Eof(0)
  CloseFile(0)

EndSelect

ClearList(Content())
EndProcedure

PureBasic Forums - English

List 3D Objects textures

List 3D Objects textures