Code archives/File Utilities/File Requester
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
A simple file requester easy to implement in your applications. | |||||
;File requester ; ;activePath$ = the active path ; ;selectedFile$ = the selected file ; ;drv$(drive) = the selected drive ; ;------------------------------------------------------------------------- Graphics3D 400, 300, 32, 2 SetBuffer BackBuffer() cam=CreateCamera () light=CreateLight() CameraClsColor cam,40, 40, 55 ;------------------------GLOBALS------------------------------------------ Global filter$=".txt" ;file filter Dim drctrs$(0) ;temp directories Dim realfiles$(0) ;temp files Dim txtfiles$(0) ;temp filtered files Dim drv$(0) ;drives Global selectedFile$ ;current selected file $ Global directories ;temp no. of directories Global drvcnt ;no. of drives Global check$ ;$ to compare with filter$ Global txtcount ;temp no. of files in a directory Global drd1 ;start position of directories to display Global drd2 ;end -"- -"- Global trd1 ;start position of files to display Global trd2 ;end -"- -"- Global dscr ;how many more directories then 20 Global tscr ;how many more files then 20 Global drive ;current drive no. Global mouseInUse ;if mouse in use Global activePath$ ;the active path ;----------------OPEN FILE------------------------------------------------ count_drives ;--------------------loop While Not KeyHit(1) RenderWorld ;highlight ^up-------------------------------------------------- If MouseY()>47 And MouseY()<60 And MouseX()>144 And MouseX()<170 Color 64,80,110 Rect 144,47,27,12 If MouseDown(1) ypos=0 ypos2=0 actualpos=0 pos=1 While (pos>actualpos)And (pos<Len(activePath$)) actualpos=pos pos=Instr(activePath$,"\",pos+1) Wend If (actualpos=1) Then actualpos=0 activePath$ =Left$(activePath$,actualpos) read_dir(drive,activePath$) selectedFile$="" Repeat Until (Not MouseDown(1)) EndIf EndIf ;---------------------- Color 56,78,112:Rect 0,30,40,270:Rect 0,0,400,29 Line 41,45,400,45:Line 41,60,400,60 Line 384,46,384,300:Line 180,46,180,300:Line 196,46,196,300 Color 50,50,75:Rect 41,30,359,15 Color 50,255,100:Line 40,0,40,300:Line 0,29,400,29 Text 1,2,"Select" Text 1,13,"Drive" Text 50,7,"Open file Back" Text 50,48,"Directories File:" Text 50,32,"Path: " Color 255,255,80:Text 80,32,drv$(drive)+":\"+Left$(activePath$, 60) Text 145,48,"|^Up|":Text 233,48,Left$(selectedFile$,29) Text 200,7,"Filter: "+filter$ ;----------------------------------------------------- If MouseY()<29 ;----open file -------------------- If MouseX()>50 And MouseX()<100 Color 50,170,170:Rect 47,3,51,23,0 ;Put here your action when open file is pressed ; If MouseDown(1) Then ..... EndIf ; back-------------------------- If MouseX()>113 And MouseX()<145 Color 50,170,170:Rect 113,3,36,23,0 If MouseDown(1) Then End EndIf EndIf ;------------------------------------------------ For t=0 To drvcnt-1 Color 50,255,100 Text 16,35+t*20,drv$(t)+":" If MouseX()<29 And MouseY()>30+t*20 If MouseY()<30+(drvcnt)*20 And MouseDown(1) drive=(MouseY()-30)/20 read_dir(drive,"") activePath$="" selectedFile$="" ypos=0 ypos2=0 EndIf ;--------------------------------------------- If MouseY()>30+(drvcnt)*20 Then Goto skip Color 50,170,170 Rect 1,31+t*20,38,20,0 If t=0 Then Goto skip Color 56,78,112 Rect 1,31+(t-1)*20,38,20,0 .skip EndIf Next ;--------------------scroller position---------------------------- If directories>19 FlushMouse() If MouseDown(1) If (MouseX()>179 And MouseX()<197 Or (mouseInUse And MouseX()<210 And MouseX()>160)) And MouseY()>61 And MouseY()<299 ypos = MouseY()-6 If dscr >0 met#=227.0/dscr drd1=Floor ((ypos-56)/met#) drd2=drd1+19 EndIf mouseInUse =True EndIf Else mouseInUse =False EndIf Color 255,234,99 If (ypos<62) Then ypos=62 If (ypos>284) Then ypos=284 Rect 182,ypos,13,15 EndIf ;----------------------------------------------- If txtcount>19 FlushMouse() If MouseDown(1) If (MouseX()>383 And MouseX()<400 Or (mouseInUse And MouseX()<400 And MouseX()>360)) And MouseY()>61 And MouseY()<292 ypos2 = MouseY()-6 If tscr >0 met2#=227.0/tscr trd1=Floor ((ypos2-56)/met2#) trd2=trd1+19 EndIf mouseInUse =True EndIf Else mouseInUse =False EndIf Color 255,234,99 If (ypos2<62) Then ypos2=62 If (ypos2>284) Then ypos2=284 Rect 386,ypos2,13,15 EndIf ;---------------------file selector highlight----------------------------- If MouseY()>60 And MouseX()>50 And MouseX()<180 And (Not mouseInUse) Color 64,80,110 Rect 49,49+((MouseY()-46)/12)*12,130,11 FlushMouse() If MouseDown(1) dirmet=(drd1+Floor ((MouseY()-46)/12))-1 If dirmet<directories activePath$ = activePath$+drctrs$(dirmet)+"\" read_dir(drive,activePath$) ypos=0 ypos2=0 selectedFile$="" EndIf Repeat Until Not MouseDown(1) EndIf EndIf ;-------------------------------------------------------------------- If MouseY()>60 And MouseX()>202 And MouseX()<384 And (Not mouseInUse) Color 64,80,110 Rect 201,49+((MouseY()-46)/12)*12,182,11 If MouseDown(1) filmet=(trd1+Floor ((MouseY()-46)/12))-1 If filmet<txtcount selectedFile$ = txtfiles$(filmet) EndIf Repeat Until Not MouseDown(1) EndIf EndIf ;----------display Directories and Files------------- display Flip Wend ;---------------F U N C T I O N S ---------------------------------------- ;---------------READ_DIR-------------------------------------------------- Function read_dir(drive,path$) directories=0 drf=0 drd1=0 trd1=0 dir=ReadDir (drv$(drive)+":\"+path$) Repeat file$=NextFile$(dir) If file$="" Then Goto readfiles drf=drf+1 If file$<>".." And file$<>"." If FileType (drv$(drive)+":\"+path$+file$)=2 Then directories=directories+1 EndIf Forever ;--------readfiles--------------------------- .readfiles Dim drctrs$(directories) Dim realfiles$(drf-directories) tempdir=(ReadDir(drv$(drive)+":\"+path$)) tmpcnt=0 For i=0 To drf-1 temp$=NextFile$(tempdir) If FileType (drv$(drive)+":\"+path$+temp$)=2 If temp$<>".." And temp$<>"." drctrs$(tmpcnt)=temp$ tmpcnt=tmpcnt+1 EndIf Else realfiles$(i-tmpcnt)=temp$ EndIf Next ; sort directories For i=1 To directories-1 If Upper(drctrs$(i))< Upper(drctrs$(i-1)) temp$ = Upper(drctrs$(i-1)) drctrs$(i-1) = Upper(drctrs$(i)) drctrs$(i) =Upper$(temp$) For j= i-1 To 1 Step -1 If drctrs$(j)<drctrs$(j-1) temp$ = Upper(drctrs$(j-1)) drctrs$(j-1) = Upper(drctrs$(j)) drctrs$(j) =Upper(temp$) Else j=1 EndIf Next EndIf Next ; get only filtered files tmpcnt=0 For i=0 To drf-directories-1 check$ = Right(realfiles$(i),4) check$=Lower(check$) If (check$=filter$) tmpcnt=tmpcnt+1 EndIf Next txtcount =tmpcnt Dim txtfiles$(txtcount+21) tmpcnt=0 For i=0 To drf-directories-1 check$ = Right(realfiles$(i),4) check$=Lower(check$) If (check$=filter$) txtfiles$(tmpcnt)=realfiles$(i) tmpcnt=tmpcnt+1 EndIf Next ; sort filtered files For i=1 To txtcount-1 If Upper(txtfiles$(i)) < Upper(txtfiles$(i-1)) temp$ = Upper(txtfiles$(i-1)) txtfiles$(i-1) = Upper(txtfiles$(i)) txtfiles$(i) =temp$ For j= i-1 To 1 Step -1 If txtfiles$(j)<txtfiles$(j-1) temp$ = Upper(txtfiles$(j-1)) txtfiles$(j-1) = Upper(txtfiles$(j)) txtfiles$(j) = Upper(temp$) Else j=1 EndIf Next EndIf Next ;---if more then 20 directories or files calculate how many more If directories<20 drd2=directories-1 Else drd2=19:dscr=directories-20 EndIf If txtcount<20 trd2=txtcount-1 Else trd2=19:tscr=txtcount-20 EndIf End Function ;-------------------DISPLAY----------------------------------------------- Function display() Color 70,255,220 For i=drd1 To drd2 Text 50,60+12*(i-drd1), Left$(drctrs$(i),25) Next Color 180,180,230 For i=trd1 To trd2 Text 205,60+12*(i-trd1), Left$(txtfiles$(i),35) Next End Function ;---------COUNT_DRIVES---------------------------------------------------- Function count_drives() drvcnt=0 Dim drv$(14) For i=Asc("C") To Asc("K") ;For i=Asc("c") To Asc("k");put this if the above doesn't work fr=ReadDir(Chr$(i)+":\") If fr<>0 Then drv$(drvcnt)=Chr$(i) drvcnt=drvcnt+1 CloseDir(fr) EndIf Next End Function |
Comments
None.
Code Archives Forum