FileRequester2 tuned ;)
"FileRequester.bas"
FileRequester2 changes:
Code: Select all
'declare function FileRequester2(PosX as integer,PosY as integer,akcion as string,Path as string, File as string="",FExistMode as integer=0) as string 'old
declare function FileRequester2(PosX as integer,PosY as integer,akcion as string,Path as string, File as string="",FExistMode as integer=0,fileMask as string="") as string
'declare sub FindContent(gad as Gadget ptr,t as string ) 'orig
declare sub FindContent(gad as Gadget ptr,t as string,fileMask as string="") 'my
(...)
function FileRequester2(PosX as integer,PosY as integer,akcion as string,Path as string, File as string="",FExistMode as integer=0,fileMask as string="") as string
(...)
TO_ClearText(contlist)
FindContent(contlist,"D")
'FindContent(contlist,"F") 'orig
if fileMask<>"" then 'my
FindContent(contlist,"F",fileMask) 'my
else
FindContent(contlist,"F") 'orig
end if
UpdateGadget(contlist)
(...)
if event->GADGETMESSAGE then
select case event->GADGETMESSAGE
'===========================================
'Pfadeingabe
case strpath
chdir GetString(strpath) 'Wechsel ins Directory
Path=curdir 'Setze aktuellen Pfad
if right(Path,1)<>sep then Path+=sep 'fix path slash if missing
TO_ClearText(contlist)
FindContent(contlist,"D")
' FindContent(contlist,"F") 'orig
if fileMask<>"" then FindContent(contlist,"F",fileMask) else FindContent(contlist,"F") 'my
UpdateGadget(contlist)
SetString(strpath,Path) 'Aktualisiere die Pfadanzeige
'===========================================
case contlist
entry=TO_GetLineContent(contlist,GetListBoxVal(contlist))
if entry<>"" then
if left(entry,6)="<DIR> " then 'wenn entry ein Directory
GadgetSleep(aFileMask)
GoToFolder=right(entry,len(entry)-6)
chdir GoToFolder 'Wechsel ins Directory
Path=curdir 'Setze aktuellen Pfad
if right(Path,1)<>sep then Path+=sep 'fix path slash if missing
TO_ClearText(contlist)
FindContent(contlist,"D")
' FindContent(contlist,"F") 'orig
if fileMask<>"" then FindContent(contlist,"F",fileMask) else FindContent(contlist,"F") 'my
UpdateGadget(contlist)
SetString(strpath,Path) 'Aktualisiere die Pfadanzeige
else 'non-directory
GadgetOn(aFileMask)
end if
File=entry
SetString(strfile,File)
end if
'===========================================
case cdparent
chdir ".." 'Wechsel ins übergeordnete Directory
Path=curdir 'Setze aktuellen Pfad
if right(Path,1)<>sep then Path+=sep 'fix path slash if missing
TO_ClearText(contlist)
FindContent(contlist,"D")
' FindContent(contlist,"F") 'orig
if fileMask<>"" then FindContent(contlist,"F",fileMask) else FindContent(contlist,"F") 'my
UpdateGadget(contlist)
SetString(strpath,Path) 'Aktualisiere die Pfadanzeige
'===========================================
'Beenden und Rückabe eines Strings
case doit
(...)
Code: Select all
'sub FindContent(gad as Gadget ptr,t as string ) 'orig
sub FindContent(gad as Gadget ptr,t as string,fileMask as string="") 'my
dim as integer attr
dim as string entryname,pre
if ucase(t)="D" then 'bei "D" suche nach Verzeichnissen
attr=&H10 + &H01
pre="<DIR> " '"Vorsilbe" um Verzeichnisse von Dateien unterscheiden zu können
end if 'orig
if ucase(t)="F" then 'bei "F" suche nach Dateien
attr=&H00
pre=""
end if
entryname=dir("*",attr)
if fileMask<>"" then entryname=dir("*."+fileMask,attr) 'my
do
if (len(entryname)>0) and (entryname<>".") and (entryname<>"..") then TO_AppendLine(gad,pre & entryname) 'orig
entryname=dir
loop while len(entryname)
end sub
- directly to find files with mask, e.g *.WDproj
Code: Select all
WDprojFile=FileRequester2(160,80,"Load",curdir,,1,"WDproj")
Note - FindContent() could be tuned more without header change, for now untouched.
S'shot -
http://www.4shared.com/download/cDRSG0PRce/FR2a.png
