cGetFile()

Post Reply
User avatar
Carles
Posts: 1151
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Been thanked: 7 times
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..."

UT Page -> https://carles9000.github.io/
Forum UT -> https://discord.gg/bq8a9yGMWh
Skype -> https://join.skype.com/cnzQg3Kr1dnk
User avatar
Antonio Linares
Site Admin
Posts: 42582
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 36 times
Been thanked: 86 times
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: 42582
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 36 times
Been thanked: 86 times
Contact:

Post by Antonio Linares »

Carles,

Aquí está:

Code: Select all | Expand

#include "FWCE.ch"function Main()   MsgInfo( cGetFile( "*.*", "\" ) )   return nilstatic 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 cFileNamestatic 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 nilstatic 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 aItemsstatic 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: 1151
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Been thanked: 7 times
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..."

UT Page -> https://carles9000.github.io/
Forum UT -> https://discord.gg/bq8a9yGMWh
Skype -> https://join.skype.com/cnzQg3Kr1dnk
User avatar
Antonio Linares
Site Admin
Posts: 42582
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 36 times
Been thanked: 86 times
Contact:

Post by Antonio Linares »

Carles,

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

Code: Select all | Expand

// FWPPC own function cGetFile() implementation#include "FWCE.ch"function Main()   MsgInfo( cGetFile( "*.*", "\" ) )   return nilstatic function cGetFile( cMask, cPath )      local oGetFile := TGetFile():New( cMask, cPath )   return oGetFile:cFileNameCLASS 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 nilMETHOD 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 nilMETHOD 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: 42582
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Has thanked: 36 times
Been thanked: 86 times
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: 1151
Joined: Fri Feb 10, 2006 2:34 pm
Location: Barcelona
Been thanked: 7 times
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..."

UT Page -> https://carles9000.github.io/
Forum UT -> https://discord.gg/bq8a9yGMWh
Skype -> https://join.skype.com/cnzQg3Kr1dnk
Post Reply