En base al ejemplo xBrwDisk.prg construí una funcion similar a cGetDir()
Ejemplo con cGetDir()
Ejemplo con cFWGetDir()
Si no hay otra mejor, AYUDENME a mejorarla.
CARACTERISTICAS:
- Se puede indicar la carpeta inical (si es vacio, mostrara las unidades de disco)
- Puede crear carpetas, DUPLICARLAS, renombrarlas, eliminarlas
- Se puede indicar que botones va a mostrar
- Puede mostrar, tambien, archivos
NOTA: no adjunto los bitmaps, pero pueden colocarlas a su gusto.
Aca el codigo
Code: Select all
//-------------------------------------------------------------------------------------------------------------//
//Funcion cFWGetDir
//-------------------------------------------------------------------------------------------------------------//
function cFWGetDir(nTop, nLeft, nBottom, nRight, cCaption,;
cPath,;
lVerColSize,lVerColDate,lVerColTime,lVerColAttr,;
lSoloFolder,;
lBtnAdd,lBtnDuplicate,lBtnRename,lBtnDelete)
local oDlg, oCtrl, oBrw, oTree, oItem, oFont, b
local cNuevaCarpeta := Space(64)
DEFAULT nTop:=10,;
nLeft:=10,;
nBottom:=640,;
nRight:=440,;
cCaption:="Seleccione una carpeta"
DEFAULT lVerColSize:=.T.,;
lVerColDate:=.T.,;
lVerColTime:=.T.,;
lVerColAttr:=.T.
DEFAULT lSoloFolder := .T.
DEFAULT lBtnAdd := .T.,;
lBtnDuplicate := .T.,;
lBtnRename := .T.,;
lBtnDelete := .T.
oTree := MakeTree(cPath,lSoloFolder)
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE DIALOG oDlg SIZE nRight,nBottom PIXEL ;
TITLE cCaption ;
FONT oFont
@ 10,10 XBROWSE oBrw SIZE nRight/2-10-10,nBottom/2-10-10 -10 PIXEL OF oDlg //NOBORDER
//oBrw:lHScroll := .F.
oBrw:lHeader := .F.
oBrw:lRecordSelector := .F.
oBrw:SetTree( oTree, { ".\bitmaps\open2.bmp", ;
".\bitmaps\folder.bmp", ;
".\bitmaps\onepage2.bmp" } )
oBrw:bKeyChar := { |nKey| If( nKey == VK_RETURN .and. ! Empty( oBrw:oTreeItem:bAction ), ;
Eval( oBrw:oTreeItem:bAction, oBrw:oTreeItem ), nil ) }
WITH OBJECT oBrw:aCols[ 1 ]
:AddBmpFile( ".\bitmaps\hdrive.bmp" )
:nWidth := 300
:cHeader := 'File/Folder'
b := :bLDClickData
:bLDClickData := { |r,c,f,o| ToggleFolder( r,c,f,o,b ) }
:bBmpData := { || If( ':' $ oBrw:oTreeItem:cPrompt, 4, ;
If( 'D' $ oBrw:oTreeItem:Cargo[ 5 ], ;
If( oBrw:oTreeItem:lOpened, 1, 2 ), 3 ) ) }
:bStrData := { || oBrw:oTreeItem:cPrompt}
END
if lVerColSize
ADD TO oBrw DATA oBrw:oTreeItem:Cargo[ 2 ] ;
PICTURE '@EZ 999,999,999' HEADER 'Bytes'
endif
if lVerColDate
ADD TO oBrw DATA oBrw:oTreeItem:Cargo[ 3 ] HEADER 'Date'
endif
if lVerColTime
ADD TO oBrw DATA oBrw:oTreeItem:Cargo[ 4 ] HEADER 'Time'
endif
if lVerColAttr
ADD TO oBrw DATA oBrw:oTreeItem:Cargo[ 5 ] HEADER 'Attr'
endif
oBrw:CreateFromCode()
@ nBottom/2-10-5, nRight/2-10-35 BUTTONBMP oCtrl;
SIZE 35, 12 OF oDlg;
ACTION oDlg:End(0);
PROMPT SPACE(3)+"Cancel";
BITMAP 'EXIT'PIXEL CANCEL TEXTRIGHT
@ oCtrl:nTop, oCtrl:nLeft-35-1 BUTTONBMP oCtrl;
SIZE 35, 12 OF oDlg;
ACTION oDlg:End(1);
PROMPT SPACE(3)+"Select";
BITMAP 'V' PIXEL DEFAULT TEXTRIGHT
if lBtnDelete
@ oCtrl:nTop, oCtrl:nLeft-14-1 BUTTONBMP oCtrl;
SIZE 14, 12 OF oDlg;
ACTION (if(MsgNoYes("Eliminar carpeta: "+oBrw:oTreeItem:Cargo[1]),;
if(DirRemove(oBrw:oTreeItem:Cargo[6])=0,;
oBrw:oTreeItem:Delete(oBrw:oTreeItem:Parent():oTree),;
MsgStop("NO se pudo eliminar: "+oBrw:oTreeItem:Cargo[1])),;
NIL),;
oBrw:SetFocus());
BITMAP 'Del' PIXEL
oCtrl:cToolTip:="Elimina la carpeta seleccionada"
endif
if lBtnRename
@ oCtrl:nTop, oCtrl:nLeft-14-1 BUTTONBMP oCtrl;
SIZE 14, 12 OF oDlg;
ACTION (cNuevaCarpeta:=PADR(oBrw:oTreeItem:Cargo[1],64),;
if(MsgGet( "System", "Renombrar: "+oBrw:oTreeItem:Cargo[1], @cNuevaCarpeta ),;
if(!(UPPER(ALLTRIM(oBrw:oTreeItem:Cargo[6]))==UPPER(cFilePath(oBrw:oTreeItem:Cargo[6])+ALLTRIM(cNuevaCarpeta))).AND.;
FRename(ALLTRIM(oBrw:oTreeItem:Cargo[6]),cFilePath(oBrw:oTreeItem:Cargo[6])+ALLTRIM(cNuevaCarpeta))=0,;
(oBrw:oTreeItem:SetText( RTRIM(cNuevaCarpeta) ),;
oBrw:oTreeItem:Cargo[1]:=RTRIM(cNuevaCarpeta),;
oBrw:oTreeItem:Cargo[6]:=cFilepath(oBrw:oTreeItem:Cargo[6])+ALLTRIM(cNuevaCarpeta)),;
MsgStop("NO se pudo renombrar: "+oBrw:oTreeItem:Cargo[1])),;
NIL),;
oBrw:SetFocus());
BITMAP 'Edit' PIXEL
oCtrl:cToolTip:="Cambia el nombre de la carpeta seleccionada"
endif
if lBtnDuplicate
@ oCtrl:nTop, oCtrl:nLeft-14-1 BUTTONBMP oCtrl;
SIZE 14, 12 OF oDlg;
ACTION (if(DirDuplicate(oBrw:oTreeItem:Cargo[6]),;
oBrw:oTreeItem:Parent( ):SetTree( SubTree( oBrw:oTreeItem:Parent( ), lSoloFolder ) ),;
MsgStop("NO se pudo duplicar: "+oBrw:oTreeItem:Cargo[1])),;
oBrw:SetFocus());
BITMAP 'Duplicate' PIXEL
oCtrl:cToolTip:="Duplica la carpeta seleccionada"
endif
if lBtnAdd
@ oCtrl:nTop, oCtrl:nLeft-14-1 BUTTONBMP oCtrl;
SIZE 14, 12 OF oDlg;
ACTION (cNuevaCarpeta:=PADR(oBrw:oTreeItem:Cargo[1],64),;
if(MsgGet( "System", "Nueva carpeta", @cNuevaCarpeta ),;
if(MakeDir( oBrw:oTreeItem:Cargo[ 6 ] + Chr(92) + ALLTRIM(cNuevaCarpeta))=0,;
(oBrw:oTreeItem:SetTree( SubTree( oBrw:oTreeItem, lSoloFolder ) ),;
oBrw:oTreeItem:bAction:=0,;
if(oBrw:oTreeItem:lOpened,;
NIL,;
oBrw:oTreeItem:Toggle() )),;
MsgStop("NO se pudo crear: "+ALLTRIM(cNuevaCarpeta))),;
NIL),;
oBrw:SetFocus());
BITMAP 'Add' PIXEL
oCtrl:cToolTip:="Crea una nueva carpeta"
endif
ACTIVATE DIALOG oDlg CENTER
return if(oDlg:nResult=0,NIL,oBrw:oTreeItem:Cargo[ 6 ])
//----------------------------------------------------------------------------//
static function ToggleFolder( r, c, f, oCol, b )
local oBrw := oCol:oBrw
local oItem := oBrw:oTreeItem
If ! oItem:lOpened .and. ! Empty( oItem:bAction )
Eval( oItem:bAction, oItem )
endif
if b != nil
Eval( b, r, c, f, oCol )
endif
return nil
//----------------------------------------------------------------------------//
static function MakeTree(cFolder,lSoloFolder)
local oTree, oItem, n, nItems := 0
local aDrives := aDrives( 2 ) // Hard disks
local cNDrive
DEFAULT lSoloFolder := .T.
TREE oTree
if EMPTY(cFolder)// = NIL
for n := 1 to Len( aDrives )
cNDrive:=GetVolInfo( aDrives[ n ]+"\" )
TREEITEM oItem PROMPT if( EMPTY(cNDrive),"Disco local",cNDrive ) +" ("+ aDrives[ n ] +")"
oItem:Cargo := { aDrives[ n ], 0, CtoD( '' ), Space( 8 ), 'D', ;
aDrives[ n ] }
oItem:bAction := { |o| o:SetTree( SubTree( o, lSoloFolder ) ), o:bAction := nil }
next
else
TREEITEM oItem PROMPT cFileNoPath(cFolder)
oItem:Cargo := { cFileNoPath(cFolder), 0, CtoD( '' ), Space( 8 ), 'D', ;
cFolder }
oItem:bAction := { |o| o:SetTree( SubTree( o, lSoloFolder ) ), o:bAction := nil }
oItem:SetTree( SubTree( oItem, lSoloFolder ) )
oItem:Toggle()
endif
ENDTREE
return oTree
//----------------------------------------------------------------------------//
static function SubTree( oParent,lSoloFolder )
local oTree, n, oItem, nLevel, nItems := 0
local cFolder := oParent:Cargo[ 6 ]
local aDir := Directory( cFolder + '\*.*', 'D' )
DEFAULT lSoloFolder := .T.
nLevel := oParent:nLevel + 1
TREE oTree
for n := 1 to Len( aDir )
if ! ( aDir[ n ][ 1 ] = '.' ) .AND. (!lSoloFolder .OR. 'D' $ aDir[ n ][ 5 ] )
TREEITEM oItem PROMPT aDir[ n ][ 1 ]
oItem:nlevel := nLevel
oItem:Cargo := aDir[ n ]
AAdd( oItem:Cargo, cFolder + Chr(92) + aDir[ n ][ 1 ] )
if 'D' $ aDir[ n ][ 5 ]
oItem:bAction := { |o| o:SetTree( SubTree( o, lSoloFolder ) ), o:bAction := nil }
else
oItem:bAction := { |o| MsgInfo( o:cPrompt ) }
endif
nItems++
endif
next
/*
if nItems == 0
n--
TREEITEM oItem PROMPT ''
oItem:nlevel := nLevel
aDir[ n ][ 5 ] := 'A'
oItem:Cargo := { '', 0, CToD( '' ), Space(8), ' ', '' }
AAdd( oItem:Cargo, cFolder + Chr(92) + aDir[ n ][ 1 ] )
endif
*/
ENDTREE
return oTree
//----------------------------------------------------------------------------//
//function DirDuplicate( cName, cPath )
function DirDuplicate( cPath )//16/08/13
local cPathOrg,cFolder,cFolderCpy,cCpy, aFiles, n:=0
cPath:=RTRIM(cPath)
if Right(cPath,1)="/"
cPath:=Left(cPath,len(cPath)-1)
endif
cPathOrg:=cPath
cFolder:=cFileNoPath(cPath)
cPath:=cFilePath(cPath)
WHILE .T.
cCpy := " (Copia " + cValToChar( ++n ) + ")"
cFolderCpy := cFolder + cCpy
if !IsDirectory( cPath + cFolderCpy ) .OR. n > 1000
EXIT
ENDIF
END
cPath := cPath + cFolderCpy
IF lRMkDir( cPath )
aDir( cPathOrg + "\*.*", aFiles:=ARRAY( aDir(cPathOrg + "\*.*") ) )
aEval( aFiles, {|cFile| FileCopy(cPathOrg + "\" + cFile, cPath + "\" + cFile) } )
else
MsgStop("No se puede crear la carpeta de la Base de Datos copiada","DirDuplicate(..)")
Return .F.
EndIf
Return .T.
//FIN Funcion cFWGetDir ----------------------------------------------------------------------------//
Atentamente,
Rolando
Cochabamba - Bolivia
FWH 1109 - xHarbour 1.1.0 (SimpLex) - BCC58
