// C:\FWH\SAMPLES\ELIXIR.PRG - NEW VRSION - 28/09/2024 - Mod: by Kapiaba.
#include "FiveWin.ch"
STATIC oImageList, cPath, lOk := .F., lExit := .F.
FUNCTION Main()
LOCAL oDlg, oGet, cText := "", oFont, oFnt
SkinButtons() // COLOR IN BUTTONS
DEFINE FONT oFnt NAME "Ms Sans Serif" SIZE 0, 14 BOLD
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -14 BOLD
DEFINE DIALOG oDlg SIZE 1000, 800 FONT oFont
oDlg:lHelpIcon := .F.
// 350, 300
@ 0, 100 GET oGet VAR cText MEMO SIZE 395, 350 PIXEL OF oDlg FONT oFont
ACTIVATE DIALOG oDlg ; // CENTERED ;
ON INIT Choice_Image( oDlg, oGet )
// ON INIT BuildTree( oDlg, oGet ) // OLD Version.
oFont:End()
oFnt:End()
lExit := .F.
IF .NOT. EMPTY( oImageList )
oImageList:End()
ENDIF
RETURN NIL
FUNCTION Choice_Image( oDlg, oGet )
LOCAL oDlgC, oDir, oOk, cDir := "C:\FWH1905" // Space( 256 ) -> A tu gusto!
LOCAL oFont, oFnt, oExit, oSel
DEFINE FONT oFnt NAME "Ms Sans Serif" SIZE 0, 14 BOLD
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -14 BOLD
DEFINE DIALOG oDlgC SIZE 400, 200 PIXEL TRANSPARENT FONT oFont ;
TITLE "Choice Directory Of Images For Tree" COLOR CLR_BLACK, CLR_WHITE
oDlgC:lHelpIcon := .F.
@ 12, 5 SAY "Directory:" OF oDlgC SIZE 60, 12 PIXEL TRANSPARENT UPDATE ;
FONT oFont COLOR METRO_ORANGE, CLR_WHITE
@ 10, 45 GET oDir VAR cDir OF oDlgC SIZE 100, 12 PIXEL UPDATE FONT oFont
@ 38.50, 5 SAY "New Version: Choice Directory Of Images For Tree" OF oDlgC ;
SIZE 200, 12 PIXEL TRANSPARENT UPDATE FONT oFont ;
COLOR METRO_CRIMSON, CLR_WHITE
@ 10, 150 BUTTONBMP oSel PROMPT "&Sel" SIZE 35, 12 PIXEL OF oDlgC ;
BITMAP "..\bitmaps\16x16\floppy.bmp" TEXTRIGHT ;
ACTION SelDir( oDlgC, oDir, @cDir )
@ 60, 45 BUTTONBMP oOk PROMPT "&Ok" SIZE 50, 14 PIXEL OF oDlgC ;
BITMAP "..\bitmaps\16x16\open.bmp" TEXTRIGHT ;
ACTION( BuildTree( oDlg, oGet, lExit := .T., oDlgc:End() ) ) WHEN( lOk )
@ 60, 100 BUTTONBMP oExit PROMPT "&Exit" SIZE 50, 14 PIXEL OF oDlgC ;
BITMAP "..\bitmaps\16x16\Exit.bmp" TEXTRIGHT ;
ACTION( lExit := .T., oDlgc:End(), __QUIT() ) CANCEL
ACTIVATE DIALOG oDlgC CENTERED VALID( lExit )
oFont:End()
oFnt:End()
lExit := .F.
RETURN NIL
FUNCTION SelDir( oDlgC, oDir, cDir )
LOCAL cTitle := "Choice Directory Of Images"
LOCAL cInitDir := cDir
LOCAL cTmpDir := AllTrim( cGetDir( cTitle, cInitDir ) )
IF .NOT. EMPTY( cTmpDir )
cDir := cTmpDir
cPath := cDir+"\*" // aqui el truco.
lOk := .T. // Button "Ok" Action
oDlgC:UpDate()
ELSE
MsgInfo( "CHOOSE A VALID DIRECTORY TO GET THE IMAGES FROM THE TREE.", ;
"CHOOSE A VALID DIRECTORY TO GET THE IMAGES FROM THE TREE." )
ENDIF
RETURN NIL
FUNCTION BuildTree( oDlg, oGet )
LOCAL oTreeView := TTreeView():New( 0, 0, oDlg )
// LOCAL cPath := "c:\FWH1905\*", oItem // OLD VERSION
LOCAL oItem
oImageList := TImageList():New()
oDlg:SetText( cPath )
oTreeView:SetSIZE( 200, oDlg:nHeight - 30 )
oTreeView:bChanged = {|| If( ( oItem := oTreeView:GetSelected() ) != nil, ;
oGet:SetText( MemoRead( oItem:Cargo ) ), ) }
oImageList:Add( TBitmap():Define( "folder",, oDlg ), ;
TBitmap():Define( "fldmask",, oDlg ) )
oImageList:Add( TBitmap():Define( "prg",, oDlg ), ;
TBitmap():Define( "prgMask",, oDlg ) )
oTreeView:SetImageList( oImageList )
ReadFiles( cPath, oTreeView )
RETURN NIL
FUNCTION ReadFiles( cPath, oTreeView )
LOCAL aFiles := Directory( cPath, "D" )
LOCAL oTreeItem, n
FOR n = 1 TO Len( aFiles )
IF aFiles[ n ][ 1 ] != "." .AND. aFiles[ n ][ 1 ] != ".."
oTreeItem = oTreeView:Add( aFiles[ n ][ 1 ], If( aFiles[ n ][ 5 ] == "D", 0, 1 ) )
IF aFiles[ n ][ 5 ] == "D"
ReadFiles( SubStr( cPath, 1, RAt( "\", cPath ) ) + aFiles[ n ][ 1 ] + "\*", oTreeItem )
ELSE
oTreeItem:Cargo = SubStr( cPath, 1, RAt( "\", cPath ) ) + aFiles[ n ][ 1 ]
ENDIF
ENDIF
NEXT
RETURN NIL
// FIN / END - kapiabafwh@gmail.com
Regards, saludos.
