| StringToFunc !!! von Markus |
| Ein Beispiel wie man Positionen ect. als Textdatei speichert und wieder ganz einfach ausließt . Dafür list man Zeilenweise eine Textdatei ein und übergibt diese zeile der Funktion StringToFunc(Zeile$) In dieser Funktion werden dann Commandos ausgewertet in Select Case . z.B. TREE:10,0,20,100 Erzeugt dann im Beispiel einen Baum an XYZ mit größe 100 . Alles was mit Komma getrennt ist wird in Parameter für eine Funktion umgewandelt . Also mit dem Beispiel könnt ihr z.B. eure Scene speichern und auch wieder laden . Denke mal das diese Funk. sehr gut ist 8) Hab ich auch in mein Achterbahn Projekt eingebaut . Uhrsprünglich war das ne TCP Schnittstelle von VB nach BB , also auch für Netzwerk Kommunikation sehr gut :!: [code:1:f6001c25ed] Dim para$(128) ;um einzelne Zeilen einer Textdatei in Parameter umzuwandeln ;-------------------------------------------------------- .TREES Global tree_sprite=CreateMyTree(0,0,0) HideEntity tree_sprite Type TreeType Field Entity Field rn# End Type Global Tree.TreeType ;NewTrees() ;SaveTrees() LoadTrees() ;-------------------------------------------------------- ;####################################################################################### Function NewTree(x#,y#,z#,rn#) ;MR 28.04.2003 ;Neuer Baum an x,y,z größe rn Tree.TreeType=New TreeType TreeEntity=CopyEntity(tree_sprite) Tree n=rn y=TerrainY( land,x,y,z )+1 MoveEntity TreeEntity,x,y,z ;Nicht Position !? ScaleEntity TreeEntity,rn,rn*2,rn EntityBox TreeEntity,-rn/2,0,-rn/2,rn,rn*4,rn End Function ;####################################################################################### Function FreeTrees() ;MR 28.04.2003 ;Alle Bäume entfernen For Tree.TreeType=Each TreeType FreeEntity TreeEntity Delete Tree Next End Function ;####################################################################################### Function LoadTrees() ;MR 28.04.2003 ;Bäume laden aus Textdatei :-) FreeTrees ;--------------------------------------------------------------------- Print "Bäume laden ..." Local f$="DataTrees.txt" Local fh Local o$ If FileExists(f$)=True fh=ReadFile(f$) If fh Then While Not Eof(fh) o$=StringToFunc(ReadLine(fh)+Chr(13)) ;Return wird entfernt ,brauche ich aber noch ! DebugLog o$ Wend CloseFile fh EndIf ;open ok EndIf ;Datei ist da Print "OK" ;--------------------------------------------------------------------- End Function ;####################################################################################### Function SaveTrees() ;MR 28.04.2003 ;Bäume speichern in Textdatei :-) ;--------------------------------------------------------------------- Print "Bäume speichern ..." Local f$="DataTrees.txt" Local fh Local s$ fh=WriteFile(f$) If fh Then For Tree.TreeType=Each TreeType s$="TREE:"+EntityX(TreeEntity)+","+EntityY(TreeEntity)+","+EntityZ(TreeEntity)+","+Tree n WriteLine fh,s$ Next CloseFile fh EndIf ;open ok Print "OK" ;--------------------------------------------------------------------- End Function ;####################################################################################### Function CreateMyTree(x#,y#,z#) m=CreateMesh() ;front face baumtex=LoadBrush( "spr ree.bmp",3+4 ) s=CreateSurface( m,baumtex ) AddVertex s,-1,+1,0,0,0:AddVertex s,+1,+1,0,1,0 AddVertex s,+1,-1,0,1,1:AddVertex s,-1,-1,0,0,1 AddTriangle s,0,1,2:AddTriangle s,0,2,3 FreeBrush baumtex ;left face baumtex=LoadBrush( "spr ree.bmp",3+4 ) s=CreateSurface( m,baumtex ) AddVertex s,0,+1,+1,0,0:AddVertex s,0,+1,-1,1,0 AddVertex s,0,-1,-1,1,1:AddVertex s,0,-1,+1,0,1 AddTriangle s,0,1,2:AddTriangle s,0,2,3 FreeBrush baumtex PositionMesh m,0,MeshHeight(m)/2,0 EntityFX m,1+16 ;16 mit Backface ! PositionEntity m,x,y+2,z ScaleEntity m,400,400,400 EntityType m,cBaum EntityPickMode m,3 ;Box NameEntity m,"Baum" EntityAutoFade m,15000,25000 Return m End Function ;####################################################################################### Function StringToFunc$(FileInput$) ;MR 28.04.2003 ;----------------------------------------------------------------------------- String to Functions :-) Local c$,o$,x,x1,x2,p,i c$="" o$="" ;--------------------------------------------------------- ;Command x=Instr(FileInput,":") If x>1 Then c$=Mid(FileInput,1,x-1) c$=Upper(c$) EndIf ;--------------------------------------------------------- ;Clear Parameter p=0 For i=1 To 128 Para(i)="" Next ;Search for Parameters x2=0 If Len(FileInput)>x Then x1=x+1 Repeat x2=Instr(FileInput,",",x1) If x2=0 Then x2=Instr(FileInput,Chr(13),x1) ;or to End If x2>x1 Then p=p+1 Para(p)=Mid(FileInput,x1,x2-x1) x1=x2+1 EndIf If x2=Len(FileInput) Then x2=0 ;no endless loop ;-) Until x2=0 EndIf ;------------------------------------------------------------> COMMAND <--- ;Functions If Len(c$)>0 Then Select c$ Case "TREE","BAUM" ;x,y,z,rn NewTree Para(1),Para(2),Para(3),Para(4) o$=c$ Default o$="UNKNOWN COMMAND "+c$ End Select EndIf ;Command >0 ;--------------------------------------------------------- ;Output what i have done :-) If Len(o$)>0 Then o$=o$+":" If p>0 Then For i=1 To p o$=o$+Para(i) If i<p Then o$=o$+"," Next EndIf If Len(o$)>0 Then Return o$ EndIf End Function [/code:1:f6001c25ed] |
| Anhang :-) von Markus |
| [code:1:a602f5908b] Dim xz(1000,1000) ;zum verteilen der Bäume und Boxen :-) Global Land=Terrain() ;####################################################################################### Function NewTrees() ;MR 28.04.2003 FreeTrees ;--------------------------------------------------------------------- Print "Bäume erzeugen ..." Local c SeedRnd MilliSecs() For c=1 To 32000 Step 300 xz(Rnd(0,1000),Rnd(0,1000))=1 ;1=Baum Next Local sx,sy For x=0 To 1000 Step 1 For z=0 To 1000 Step 1 sx=(x-500)*100 sz=(z-500)*100 If xz(x,z)=1 Then rn=Rnd(400,800) NewTree sx,0,sz,rn EndIf Next Next Print "OK" ;--------------------------------------------------------------------- End Function ;####################################################################################### Function Terrain() ;--------------------------------------------------------------------- Print "Terrain ..." ;--> load terrain data floor_size=512 Local land=LoadTerrain("worldHMap.tga") land_scale=100000/floor_size ScaleEntity land,land_scale,5000,land_scale ;32*128 PositionEntity land,-(floor_size*land_scale)/2,0,-(floor_size*land_scale)/2 ;-4.5*128 TerrainShading land,False TerrainDetail land,1000,True EntityFX land,1 ;Maserung floor_tex=LoadTexture("worldTerrain.jpg") ScaleTexture floor_tex,256/1,256/1 TextureBlend floor_tex,2 EntityTexture land,floor_tex,0,1 ;Boden an sich floor_map=LoadTexture("TexFels.bmp") ScaleTexture floor_map,256/15,256/15 TextureBlend floor_map,2 EntityTexture land,floor_map,0,2 EntityType land,cTerrain NameEntity land,"Land" Print "OK" ;--------------------------------------------------------------------- Return Land End Function ;####################################################################################### Function FileExists(Path$) ;MR 08.01.2003 If FileSize(Path$) > 0 Then Return True Else Return False End If End Function [/code:1:a602f5908b] |
| von ??? |
| Nett, genau dasselbe macht mein "MenuScript", ist auch in den Codearchives zu finden ;) |