cGetFile()

Post Reply
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

cGetFile()

Post by Carles »

Hola,

Alguien ha podido usar correctamente la funcion cGetFile() o alguna similar ?. Alguna idea ?
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Carles,

Estamos construyendo una función cGetFile() propia de FWPPC, ya que la que proporciona el API de Windows no hay forma de hacerla funcionar.

Vamos a publicar un primer prototipo lo antes posible.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Carles,

Aquí está:

Code: Select all

#include "FWCE.ch"

function Main()

   MsgInfo( cGetFile( "*.*", "\" ) )
   
return nil

static function cGetFile( cMask, cPath )   

   local oDlg, oBrw, oBtn, aItems, cFileName := ""

   DEFAULT cMask := "*.*", cPath := "\" 
   
   aItems = GetItems( cMask, @cPath )

   DEFINE DIALOG oDlg TITLE "Please select a file" ;
      SIZE 220, 210
   
   @ 0.4, 0.7 LISTBOX oBrw ;
      FIELDS aItems[ oBrw:nAt, 1 ], aItems[ oBrw:nAt, 2 ], aItems[ oBrw:nAt, 3 ],;
             aItems[ oBrw:nAt, 4 ] ;
      HEADERS "Name", "T", "Size", "Date" ;
      COLSIZES  100, 15, 70, 40 ;
      SIZE 100, 82 ;
      ON DBLCLICK SelFile( oBrw, cMask, @cPath, @cFileName, oDlg )

   oBrw:SetArray( aItems )
   oBrw:aJustify = { .f., .f., .t., .f. }
   oBrw:bKeyChar = { | nKey | If( nKey == 13,;
                     ( SelFile( oBrw, cMask, @cPath, @cFileName, oDlg ), oBrw:SetFocus() ),) }
   
   @ 5,  3 BUTTON oBtn PROMPT "Ok" ACTION SelFile( oBrw, cMask, @cPath, @cFileName, oDlg )

   @ 5, 10 BUTTON "Cancel" ACTION oDlg:End()
   
   ACTIVATE DIALOG oDlg CENTERED
   
return cFileName

static function CheckItem( oBrw, cMask, cPath )

   local cItem := Eval( oBrw:bLine )[ 1 ]
   local cType := Eval( oBrw:bLine )[ 2 ]
   local aItems

   if cType == "D"
      if cItem == ".."
         cPath = SubStr( cPath, 1, RAt( "\", cPath ) - 1 )
         cPath = SubStr( cPath, 1, RAt( "\", cPath ) - 1 )
         aItems = GetItems( cMask, cPath += "\" )
      else   
         aItems = GetItems( cMask, cPath += cItem + "\" )
      endif   
      oBrw:SetArray( aItems )
      oBrw:nAt = 1
      oBrw:bLine = { || { aItems[ oBrw:nAt, 1 ], aItems[ oBrw:nAt, 2 ],;
                          aItems[ oBrw:nAt, 3 ], aItems[ oBrw:nAt, 4 ] } }
      oBrw:GoTop()
      oBrw:Refresh()
   endif   

return nil

static function GetItems( cMask, cPath )

   local aInfo := Directory( cPath + cMask, "D" )
   local aItems := {}, n
   
   if Len( cPath ) > 1
      AAdd( aItems, { "..", "D", "", "" } )
   endif   

   for n = 1 to Len( aInfo )
      if "D" $ aInfo[ n ][ 5 ]
         AAdd( aItems, { aInfo[ n ][ 1 ], "D", aInfo[ n ][ 2 ],;
               DToC( aInfo[ n ][ 3 ] ) } )
      endif   
   next    
   for n = 1 to Len( aInfo )
      if ! "D" $ aInfo[ n ][ 5 ]
         AAdd( aItems, { aInfo[ n ][ 1 ], "F", Str( aInfo[ n ][ 2 ] ),;
               DToC( aInfo[ n ][ 3 ] ) } )
      endif   
   next    

return aItems

static function SelFile( oBrw, cMask, cPath, cFileName, oDlg )

   if Eval( oBrw:bLine )[ 2 ] == "F"
      cFileName = cPath + Eval( oBrw:bLine )[ 1 ]
      oDlg:End()
   else
      CheckItem( oBrw, cMask, @cPath )
   endif
   
return nil          
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by Carles »

Antonio,

Funciona perfectamente ! Gracias :wink:

Una pregunta. Se toco en algun reciente build de harbour la funcion directory() ? Juraria q hace tiempo hize alguna prueba y no me iba. (Debia hacer algo mal :cry: )

Mussshas grasias.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Carles,

Con orientación a objetos el código queda más estructurado:

Code: Select all

// FWPPC own function cGetFile() implementation

#include "FWCE.ch"

function Main()

   MsgInfo( cGetFile( "*.*", "\" ) )
   
return nil

static function cGetFile( cMask, cPath )   

   local oGetFile := TGetFile():New( cMask, cPath )
   
return oGetFile:cFileName

CLASS TGetFile

   DATA  oDlg
   DATA  oBrw
   DATA  cMask
   DATA  cPath
   DATA  cFileName
   DATA  aItems
   
   METHOD New( cMask, cPath )
   METHOD CheckItem()
   METHOD GetItems()
   METHOD SelItem()
   
ENDCLASS   

METHOD New( cMask, cPath ) CLASS TGetFile

   DEFAULT cMask := "*.*", cPath := "\" 
   
   ::cMask = cMask
   ::cPath = cPath
   ::cFileName = ""
   
   ::GetItems()
   
   DEFINE DIALOG ::oDlg TITLE "Please select a file" ;
      SIZE 220, 210
   
   @ 0.4, 0.7 LISTBOX ::oBrw ;
      FIELDS ::aItems[ ::oBrw:nAt, 1 ], ::aItems[ ::oBrw:nAt, 2 ],;
             ::aItems[ ::oBrw:nAt, 3 ], ::aItems[ ::oBrw:nAt, 4 ] ;
      HEADERS "Name", "T", "Size", "Date" ;
      COLSIZES  100, 15, 70, 40 ;
      SIZE 100, 82 ;
      ON DBLCLICK ::SelItem()

   ::oBrw:SetArray( ::aItems )
   ::oBrw:aJustify = { .f., .f., .t., .f. }
   ::oBrw:bKeyChar = { | nKey | If( nKey == 13, ( ::SelItem(), oBrw:SetFocus() ),) }
   
   @ 5,  3 BUTTON oBtn PROMPT "Ok" ACTION ::SelItem()

   @ 5, 10 BUTTON "Cancel" ACTION ::oDlg:End()
   
   ACTIVATE DIALOG ::oDlg CENTERED
      
return Self      

METHOD CheckItem() CLASS TGetFile

   local cItem := Eval( ::oBrw:bLine )[ 1 ]
   local cType := Eval( ::oBrw:bLine )[ 2 ]

   if cType == "D"
      if cItem == ".."
         ::cPath = SubStr( ::cPath, 1, RAt( "\", ::cPath ) - 1 )
         ::cPath = SubStr( ::cPath, 1, RAt( "\", ::cPath ) )
         ::GetItems()
      else   
         ::cPath += cItem + "\"
         ::GetItems()
      endif   
      ::oBrw:SetArray( ::aItems )
      ::oBrw:nAt = 1
      ::oBrw:bLine = { || { ::aItems[ ::oBrw:nAt, 1 ], ::aItems[ ::oBrw:nAt, 2 ],;
                            ::aItems[ ::oBrw:nAt, 3 ], ::aItems[ ::oBrw:nAt, 4 ] } }
      ::oBrw:GoTop()
      ::oBrw:Refresh()
   endif   

return nil

METHOD GetItems() CLASS TGetFile

   local aInfo := Directory( ::cPath + ::cMask, "D" ), n
   
   ::aItems = {}
      
   if Len( ::cPath ) > 1
      AAdd( ::aItems, { "..", "D", "", "" } )
   endif   

   for n = 1 to Len( aInfo )
      if "D" $ aInfo[ n ][ 5 ]
         AAdd( ::aItems, { aInfo[ n ][ 1 ], "D", aInfo[ n ][ 2 ],;
               DToC( aInfo[ n ][ 3 ] ) } )
      endif   
   next    
   for n = 1 to Len( aInfo )
      if ! "D" $ aInfo[ n ][ 5 ]
         AAdd( ::aItems, { aInfo[ n ][ 1 ], "F", Str( aInfo[ n ][ 2 ] ),;
               DToC( aInfo[ n ][ 3 ] ) } )
      endif   
   next    

return nil

METHOD SelItem() CLASS TGetFile

   if Eval( ::oBrw:bLine )[ 2 ] == "F"
      ::cFileName = ::cPath + Eval( ::oBrw:bLine )[ 1 ]
      ::oDlg:End()
   else
      ::CheckItem()
   endif
   
return nil          
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
creswinman
Posts: 33
Joined: Thu Aug 24, 2006 3:14 am
Location: mexico
Contact:

Post by creswinman »

La funcion se ve muy bien, solo que no me muestra ningun archivo....! :cry:
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Ignacio,

La estás probando en el emulador ? Ves las carpetas principales ? Puedes entrar en la carpeta de Windows ?
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Carles
Posts: 937
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Contact:

Post by Carles »

Buenas,

Me funciona perfectamente en el emulador y el trasto.

Saludos.
Salutacions, saludos, regards

"...programar es fácil, hacer programas es difícil..."

https://modharbour.app
https://modharbour.app/compass
https://forum.modharbour.app
Post Reply