[B3D] Funny 3D Explorer
Übersicht

![]() |
BlitzCheckerBetreff: [B3D] Funny 3D Explorer |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ich hab grad auf BlitzBasic.com nen guten Code gefunden. Ich dachte ich poste ihn hier, da ihn sicherlich viele gebrauchen können:
Code: [AUSKLAPPEN] ; 3D File-Explorer
Graphics3D 640,480,16,2 SetBuffer BackBuffer() Global gw#=GraphicsWidth() Global gh#=GraphicsHeight() MoveMouse gw/2,gh/2 cam=CreateCamera() Global uni=CreateSphere(7,cam) MoveEntity cam,0,2,-6 li=CreateLight() RotateEntity li,80,30,30 ScaleEntity uni,100,100,100 FlipMesh uni EntityOrder uni,1 texname$="space.jpg" If FileType(texname$)=0 unitex=CreateTexture(128,128) SetBuffer TextureBuffer(unitex) For i=0 To 10000 Color Rand(255), Rand(255), Rand(255) Plot Rand(128), Rand(128) Next SetBuffer BackBuffer() Else unitex=LoadTexture(texname$) EndIf EntityTexture uni,unitex Global fls#=25000 ;max 25000 Files in one Folder Dim fb_icon(fls),fb_name$(fls),fb_type(fls),fb_tex(fls),fb_sel(fls) Global rheight#=4 ; x space between icons Global rwidth#=5 ; y space between icons Global fperline#=3 ; number of icon columns Global iconw#=2.0 ; icon scaling Global iconh#=1.0 Global icond#=.5 Global stexx#=1.0 ; texure scaling Global stexy#=2.0 ClearTextureFilters font=LoadFont("Tahoma",17) SetFont font mx100#=(gw/2)*.9 my100#=(gh/2)*.9 Global camxi#=5 Global camyi#=0 Global camzi#=-9.2 Global camx#=camxi# Global camy#=camyi# Global camz#=camzi# RefreshDir() ; -------------------------------------------MAIN------------------------------------------- While KeyDown(1)=0 mx#=MouseX() my#=MouseY() If my<my100 If camy<1 sty#=((my100-my)/150)^2 camy=camy+sty If camy>1 Then camy=1 EndIf EndIf If my>gh-my100 If camy>(0-(Floor(fls/fperline)*rheight)) sty#=((my100-(gh-my))/150)^2 camy=camy-sty If camy<(0-(Floor(fls/fperline)*rheight)) Then camy=(0-(Floor(fls/fperline)*rheight)) EndIf EndIf If mx>gw-mx100 If camx<(fperline)*rwidth stx#=(mx100-(gw-mx))/500 camx=camx+stx If camx>(fperline)*rwidth Then camx=(fperline)*rwidth EndIf EndIf If mx<mx100 If camx>-rwidth stx#=(mx100-mx)/500 camx=camx-stx If camx<-rwidth Then camx=-rwidth EndIf EndIf If MouseHit(1) oldmhitt=mhitt mhitt=MilliSecs() If (mhitt-oldmhitt)<300 Then ; -----------------------------is dooubleclick! p=CameraPick(cam,mx,my) If p<>0 picked_i=-1 For i=0 To fls If fb_icon(i)=p picked_i=i Exit EndIf Next If picked_i>-1 For roro=0 To 1000 dx#=(EntityX(fb_icon(picked_i),1)-EntityX(cam))/10.0;-EntityX(cam) dy#=(EntityY(fb_icon(picked_i),1)-EntityY(cam))/10.0;-EntityY(cam) dz#=(EntityZ(fb_icon(picked_i),1)-EntityZ(cam))/10.0;-EntityZ(cam) PositionEntity cam,EntityX(cam,1)+dx,EntityY(cam,1)+dy,EntityZ(cam,1)+dz,1 TurnEntity uni,.1,.1,.1 RenderWorld() PathInfo() Flip If dx<.1 And dy<.1 And dz<.1 Then Exit Next placebo=CopyEntity(fb_icon(picked_i)) ; FreeEntity fb_icon(picked_i) If fb_type(picked_i)=2 ChangeDir(fb_name$(picked_i)) EndIf EntityParent placebo,cam camx#=camxi# camy#=camyi# camz#=camzi# MoveMouse gw/2,gh/2 PositionEntity cam,camx,camy,camz,1 If Instr(fb_name$(picked_i),".")<>0 And fb_name$(picked_i)<>".." And fb_type(picked_i)=1 ; check Media Type and probably do something (some examples) ext$=Right$(fb_name$(picked_i), Len(fb_name$(picked_i))-Instr(fb_name$(picked_i),".")) ;Color 255,0,0 ; Print ext$ ; WaitKey() Select Upper$(ext$) Case "TXT" ExecFile "notepad.exe "+fb_name$(picked_i) Case "EXE" ExecFile fb_name$(picked_i) Case "HTM",".HTML" ExecFile fb_name$(picked_i) Case "BB" ExecFile fb_name$(picked_i) End Select EndIf RemoveAll() RefreshDir() For al#=1.0 To 0.0 Step -.05 EntityAlpha placebo,al# TurnEntity uni,.1,.1,.1 RenderWorld() PathInfo() Flip Next FreeEntity placebo EndIf EndIf Goto done Else ; -----------------------------is single click p=CameraPick(cam,mx,my) If p<>0 picked_i=-1 For i=0 To fls If fb_icon(i)=p picked_i=i Exit EndIf Next If picked_i>-1 For i=0 To fls If fb_sel(i)<>0 If i<>picked_i fb_sel(i)=0 EntityColor fb_icon(i),255,255,255 EndIf EndIf Next fb_sel(picked_i)=fb_sel(picked_i)Xor 1 If fb_sel(picked_i)=1 EntityColor fb_icon(picked_i),75,75,255 Else EntityColor fb_icon(picked_i),255,255,255 EndIf EndIf EndIf EndIf .done EndIf If KeyDown(200) camz=camz+.1 EndIf If KeyDown(208) camz=camz-.1 EndIf PositionEntity cam,camx,camy,camz,1 TurnEntity uni,.1,.1,.1 RenderWorld() PathInfo() Flip Wend ;--------------------------------------------eo main ------------------------------------ End Function RefreshDir() ; Define what folder to start with ... folder$=CurrentDir$() myDir=ReadDir(folder$) fls=0 Repeat fb_name$(fls)=NextFile$(myDir) If fb_name$(fls)<>"." If fb_name$(fls)="" Then Exit folder2$=folder$ If Right$(folder2$,1)<>"\" folder2$=folder2$+"\" EndIf If FileType(folder2$+fb_name$(fls)) = 2 Then fb_type(fls)=2 Else fb_type(fls)=1 End If fls=fls+1 EndIf Forever CloseDir myDir fls=fls-1 ;fls#=Rand(10,100) ;Dim fb_icon(fls),fb_name$(fls),fb_type(fls),fb_tex(fls),fb_sel(fls) For i=0 To fls fb_icon(i)=CreateCube() y=Floor(i/fperline) x=i-(y*fperline) PositionEntity fb_icon(i),x*rwidth,-(y*rheight),0 fb_tex(i)=CreateTexture(128,128) SetBuffer TextureBuffer(fb_tex(i)) If fb_type(i)=2 Color 127,127,0 Rect 0,0,256,256,1 Else Color 127,127,127 Rect 0,0,256,256,1 EndIf If StringWidth(fb_name$(i))<=126 Color 255,255,255 Text 64,0,fb_name$(i),1,0 Color 0,0,0 Text 65,1,fb_name$(i),1,0 Else lin$="" wchar=1 ycount=0 While wchar<=Len(fb_name$(i)) While StringWidth(lin$)<=122 And wchar<=Len(fb_name$(i)) lin$=lin$+Mid$(fb_name$(i),wchar,1) wchar=wchar+1 Wend If wchar<Len(fb_name$(i)) lin$=Left$(lin$,Len(lin$)-1) wchar=wchar-1 EndIf Color 255,255,255 Text 64,0+ycount*StringHeight(fb_name$(i)),lin$,1,0 Color 0,0,0 Text 65,1+ycount*StringHeight(fb_name$(i)),lin$,1,0 lin$="" ycount=ycount+1 Wend EndIf SetBuffer BackBuffer() ScaleTexture fb_tex(i),stexx,stexy EntityTexture fb_icon(i),fb_tex(i) EntityPickMode fb_icon(i),2 ScaleEntity fb_icon(i),iconw,iconh,icond EntityFX fb_icon(i),16 fb_sel(i)=0 Next End Function Function RemoveAll() For i=0 To fls FreeEntity fb_icon(i) FreeTexture fb_tex(i) Next End Function Function PathInfo() Color 127,127,127 Text 0,0,CurrentDir$() Color 255,255,255 Text 1,1,CurrentDir$() End Function[/syntax] |
||
www.xairro.com |
![]() |
Lunatix |
![]() Antworten mit Zitat ![]() |
---|---|---|
Das ist geil... cool. | ||
[size=9]Pro|gram|mier|er: Ein Organismus, der Koffein in Software umwandelt.
Geben Sie eine beliebige 11-stellige Primzahl ein, um fortzusetzen... |
![]() |
AMY |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ja schon cool bloss hab ich n paar fehler gefunden.
z.b. statt ext$=Right$(fb_name$(picked_i), Len(fb_name$(picked_i))-Instr(fb_name$(picked_i),".")) muss es heissen: Repeat ESC=instr$(fb_name$(picked_i),".",backupESC) bachupesc=esc+1 until esc=0 ext$=mid$(fb_name$(picked_i),backupesc) denn dateinamen können auch mitten im Namen einen Punkt enthalten. Das wird hiermit ausgedchaltet |
||
Projekte: www.amyscbi.de
I never comment my sourcecode. What's HARD to write must be HARD to read! |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group