my "Problem" was to handle 2 x 2 Object : Fivewin TTreeView/TTVItem and Windows Folder/Folderitem
but when add Child "dynamic" i have to use Folder/Folderitem when work with Device
now i "store" FolderItem in CARGO of TreeItem so i got right Relation of TREE and (virtual) Folder Structure
Code: Select all | Expand
*#include "FIVEWIN.CH"
* #define use_TGrid // do NOT enable for Standalone !
#define CSIDL_DRIVES 0x0011
#define cDevice "APPLE IPHONE" // change for Android
#define FOF_SIMPLEPROGRESS 0x0100
#define LVIS_FOCUSED 0x01
#define LVIS_SELECTED 0x02
#define ID_Folder 1
#define ID_Name 2
#define ID_Level 3
#define ID_Parent 4
#define ID_Element 5
STATIC oIPHONE
STATIC oTree_1
STATIC oButton_Target
STATIC oTargetDir
STATIC oButton_CopyHere
STATIC oButton_MoveHere
STATIC oFontDefault
STATIC oImageList
STATIC oShell, oFolder
STATIC oBrwCP
STATIC oGrid
STATIC oTreeLast
STATIC nLevel := 0
STATIC nElement := 0
STATIC aFileSys := {}
STATIC aGridfiles := { "", "", "", "", "", "" }
STATIC aFolder := {}
STATIC lRecursiv := .F.
STATIC c_Target
*+--------------------------------------------------------------------
*+
*+ Procedure MAIN()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE MAIN( cPara )
LOCAL nFontSize := 20
LOCAL nClrFore, nClrBack, lPixel := .T., lDesign := .F., nWidth := 200, nHeight := 600, cMsg := "", lCheckBoxes := .F., bChange, lEditable := .F.
LOCAL BFcolor, BGcolor
LOCAL aHeader := {}
LOCAL bAction := { || nil }
LOCAL nIcoLarge := 32
LOCAL nIcoSmall := 32
LOCAL lCheckbox := .T.
c_Target := SPACE( 250 )
IF !EMPTY( cPara )
lRecursiv := .T.
ENDIF
DEFINE FONT oFontDefault NAME "TAHOMA" SIZE 0, - nFontSize
ACTIVATE FONT oFontDefault
#IFDEF __HMG__
END FONT
#ENDIF
AADD( aHeader, { "Name", 200, 0, "C" } )
AADD( aHeader, { "Size", 150, 1, "N" } )
AADD( aHeader, { "Date", 110, 1, "D" } )
AADD( aHeader, { "Time", 090, 1, "C" } )
AADD( aHeader, { "Note", 250, 0, "C" } )
aGridfiles := DIRECTORY( "*.*", "DHS" )
DEFINE WINDOW oIPHONE FROM 0, 0 TO 768, 1024 PIXEL TITLE "Device " ICON "A1MAIN"
#ifdef use_TGrid
oGrid := TGrid() :New( 20, 220, bAction, oIPHONE, BFcolor, BGcolor, ;
lPixel, lDesign, 780, 600, cMsg, nIcoLarge, nIcoSmall, lCheckbox )
oGrid:aHeader := aHeader
oGrid:aSource := aGridfiles
#endif
oTree_1 := TTreeView() :New( 20, 10, oIPHONE, nClrFore, nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg, lCheckBoxes, bChange, lEditable )
oImageList := TImageList() :New()
oImageList:Add( TBitmap() :Define( "folder",, oIPHONE ), ;
TBitmap() :Define( "fldmask",, oIPHONE ) )
oTree_1:SetImageList( oImageList )
oTree_1:bLDblClick := { || DoTreeAction( oTree_1:GetSelected() ) }
oTree_1:bChanged := { || ShowGrid() }
@ 624, 010 BUTTON oButton_Target PROMPT "&Target Folder" SIZE 200, 30 PIXEL FONT oFontDefault ACTION GetTargetFolder() OF oIPHONE
@ 624, 220 GET oTargetDir VAR c_Target SIZE 780, 30 PIXEL FONT oFontDefault OF oIPHONE
@ 660, 010 BUTTON oButton_CopyHere PROMPT "&CopyHere" SIZE 100, 30 PIXEL FONT oFontDefault ACTION Start_CopyHere( .F. ) OF oIPHONE
@ 660, 110 BUTTON oButton_MoveHere PROMPT "&MoveHere" SIZE 100, 30 PIXEL FONT oFontDefault ACTION Start_CopyHere( .T. ) OF oIPHONE
oButton_CopyHere:hide()
oButton_MoveHere:hide()
#IFDEF __HMG__
END WINDOW
#ENDIF
ACTIVATE WINDOW oIPHONE ON INIT BuildRoot() VALID OnEnd() CENTER
RETURN
*+--------------------------------------------------------------------
*+
*+ Function OnEnd()
*+
*+ Called from ( iphone.prg ) 1 - procedure iphonewin()
*+ ( phone3.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
FUNCTION OnEnd()
RETURN .T.
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoTreeAction()
*+
*+ Called from ( phone3.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoTreeAction( oTreeNext )
LOCAL cThis := oTreeNext:Cargo[ 1 ]
LOCAL nItem := oTreeNext:Cargo[ 2 ]
LOCAL oFolderItem := oTreeNext:Cargo[ 3 ]
LOCAL aSelect, xFolder, xName, xLevel, xParent, xElement
LOCAL nPosi, oError
LOCAL bSaveError := ERRORBLOCK( { | oErr | BREAK( oErr ) } )
aGridfiles := {}
DO CASE
CASE nLevel = 0
BuildRoot()
CASE nLevel = 1
SearchDevice()
CASE nLevel = 2
SelectDevice()
OTHERWISE
IF !EMPTY( aFolder ) .AND. !EMPTY( cThis )
nPosi := ASCAN( aFolder, { | e | e[ ID_Name ] = UPPER( cThis ) } )
// .AND. e[ ID_Parent ] = nParent
IF nPosi > 0
aSelect := aFolder[ nPosi ]
xFolder := aSelect[ ID_Folder ]
xName := aSelect[ ID_Name ]
xLevel := aSelect[ ID_Level ]
DoTreeRecursiv( oFolderItem, xLevel + 1, .F., .F., .F., .F., oTreeNext )
ShowGrid()
ENDIF
ENDIF
ENDCASE
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure BuildRoot()
*+
*+ Called from ( phone3.prg ) 1 - procedure main()
*+ 1 - static procedure dotreeaction()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE BuildRoot()
LOCAL oTreeItem
oTree_1:DeleteAll()
oTreeItem := oTree_1:Add( "This PC", 0, 0 )
oTreeItem:Cargo := { "ROOT", 0, 0 }
nLevel := 1
aFileSys := {}
aFolder := {}
AADD( aFolder, { NIL, "This PC", 1, nElement } )
// now include at Start
SearchDevice( oTreeItem )
oTree_1:Expand()
#ifdef use_TGrid
oGrid:InitTheListView()
#endif
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure SearchDevice()
*+
*+ Called from ( phone3.prg ) 1 - static procedure dotreeaction()
*+ 1 - static procedure buildroot()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SearchDevice( oTreeRoot )
LOCAL cName, oItems
LOCAL i, iMax
LOCAL oTreeItem
LOCAL oFolderItem
nLevel := 2
oShell := CreateObject( "shell.application" )
IF NIL <> oShell
oFolder := oShell:NameSpace( CSIDL_DRIVES ) // 0x0011 // My Computer
IF NIL <> oFolder
// https://learn.microsoft.com/de-de/windows/win32/shell/folder-items
oItems := oFolder:Items()
iMax := oItems:Count
FOR i := 1 TO iMax
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem
oFolderItem := oItems:Item( i - 1 )
IF !EMPTY( oFolderItem )
cName := UPPER( oFolderItem:name )
IF cName = "DESKTOP"
LOOP
ENDIF
IF ASCAN( aFolder, { | e | e[ ID_Name ] = cName } ) > 0
ELSE
nElement ++
oTreeItem := oTreeRoot:Add( cName, 0, nElement )
oTreeItem:Cargo := { cName, nLevel, oFolderItem } // next Level Action
AADD( aFolder, { oTreeItem, cName, nLevel, oFolder } )
oTreeLast := oTreeItem
IF .NOT. oFolderItem:isFileSystem
AADD( aFileSys, i )
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
Sysrefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure SelectDevice()
*+
*+ Called from ( phone3.prg ) 1 - static procedure dotreeaction()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SelectDevice()
LOCAL cThis, oItems
LOCAL i, iMax, xParent := 0
LOCAL nItem
LOCAL oFolderItem
nLevel := 3
IF NIL <> oFolder
oItems := oFolder:Items()
iMax := oItems:Count
FOR i := 1 TO iMax
oFolderItem := oItems:Item( i - 1 )
IF !EMPTY( oFolderItem )
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem-name
cThis := UPPER( oFolderItem:name )
IF UPPER( cThis ) = cDevice
// EXIT here
EXIT
ENDIF
ENDIF
NEXT
ENDIF
Sysrefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoTreeRecursiv()
*+
*+ Called from ( phone3.prg ) 1 - static procedure dotreeaction()
*+ 1 - static procedure dotreerecursiv()
*+ 1 - static procedure start_copyhere()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoTreeRecursiv( xFolder, xLevel, xRecursiv, lTransfer, lMove, lisFileSys, oTreeNext )
LOCAL xThis, xItems
LOCAL ii, iMax, xFolderItem
LOCAL c_Name, c_Size, c_Date, c_Attr, c_Type
LOCAL cTarget := c_Target
LOCAL oTreeItem
LOCAL oItemParent
DEFAULT lTransfer := .F.
DEFAULT lisFileSys := .T.
IF NIL <> xFolder
nLevel := xLevel
// https://learn.microsoft.com/en-us/windows/win32/shell/folderitem-getfolder
xItems := xFolder:GetFolder:Items()
IF lTransfer = .T.
#ifdef use_TGrid
DoCopySingle( xItems, cTarget, lMove )
#endif
ELSE
iMax := xItems:Count
FOR ii := 1 TO iMax
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem
xFolderItem := xItems:Item( ii - 1 )
IF !EMPTY( xFolderItem )
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem-islink
IF xFolderItem:IsLink
LOOP
ENDIF
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem-isfolder
IF xFolderItem:IsFolder // is it a folder
// https://learn.microsoft.com/de-de/windows/win32/shell/folderitem-name
xThis := UPPER( xFolderItem:name )
IF ASCAN( aFolder, { | e | e[ ID_Name ] = xThis } ) > 0
ELSE
nElement ++
oTreeItem := oTreeNext:Add( xThis, 0, xLevel )
oTreeItem:Cargo := { xThis, xLevel, xFolderItem } // next Level Action
oTreeNext:Expand()
AADD( aFolder, { oTreeItem, xThis, nLevel + 1, xFolder } )
// not used here
IF xRecursiv = .T.
oTreeLast := oTreeItem
DoTreeRecursiv( xFolderItem, xLevel + 1, xRecursiv, .F., .F., lisFileSys, oTreeNext )
ENDIF
ENDIF
ELSE
c_Name := xFolderItem:name
c_Size := xFolderItem:Size
c_Date := xFolderItem:ModifyDate
c_Type := xFolderItem:Type
c_Attr := ""
AADD( aGridfiles, { c_Name, c_Size, c_Date, c_Attr, c_Type, LTRIM( STR( xLevel + 1 ) ) } )
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure GetTargetFolder()
*+
*+ Called from ( phone3.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE GetTargetFolder()
LOCAL cFolder := cGETFOLDER( "Get Target Folder", c_Target )
IF !EMPTY( cFolder )
c_Target := EndwithSlash( cFolder )
oTargetDir:Refresh()
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ShowGrid()
*+
*+ Called from ( phone3.prg ) 1 - procedure main()
*+ 1 - static procedure dotreeaction()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ShowGrid()
oButton_CopyHere:Show()
oButton_MoveHere:Show()
#ifdef use_TGrid
oGrid:aSource := aGridfiles
oGrid:ClearAndFill( oIPHONE )
#endif
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure Start_CopyHere()
*+
*+ Called from ( phone3.prg ) 2 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Start_CopyHere( lMove )
LOCAL nPosi
LOCAL nItem := oTreeLast:Cargo[ 2 ] // IPHONE.Tree_1.Value
LOCAL cThis := oTreeLast:Cargo[ 1 ] // TRIM( IPHONE.Tree_1.Item( nItem ) )
LOCAL oFItem := oTreeLast:Cargo[ 3 ]
LOCAL lTransfer := .T.
LOCAL aSelect, xFolder, xName, xLevel, xParent, xElement, xOther
IF !EMPTY( aGridfiles )
IF nItem > 0
aSelect := aFolder[ nItem ]
xFolder := aSelect[ ID_Folder ]
xName := aSelect[ ID_Name ]
xLevel := aSelect[ ID_Level ]
xOther := aSelect[ 4 ]
fwlog hb_valToExp( xFolder ) // Folder-Object
fwlog hb_valToExp( xName ) // OK String
fwlog hb_valToExp( xLevel ) // OK Number
fwlog hb_valToExp( xOther ) // OLE
fwlog hb_valToExp( oTreeLast ) // TTVITEM
fwlog hb_valToExp( oFItem ) // TOLEAUTO
DO CASE
CASE xFolder:IsDerivedFrom( "TTreeItem" )
FWLOG "TTreeItem"
CASE xFolder:IsDerivedFrom( "TTreeView" )
FWLOG "TTreeView"
CASE xFolder:IsDerivedFrom( "TTVItem" )
FWLOG "TTVItem"
OTHERWISE
ENDCASE
DoTreeRecursiv( oFItem, xLevel, .F., lTransfer, lMove ) // "TOLEAUTO"
* DoTreeRecursiv( xFolder, xLevel, .F., lTransfer, lMove ) // "TTVItem"
ENDIF
ENDIF
sysrefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function GoNext()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION GoNext()
LOCAL oSelItem := oTree_1:GetSelected(), lStop := .F., oNextItem
LOCAL lRet := .T.
oTree_1:Scan( { | oItem | IF( oItem:hItem == oSelItem:hItem, lStop := .T., ), ;
IF( lStop .AND. oItem:hItem != oSelItem:hItem, ( oNextItem := oItem, .T. ), .F. ) } )
IF oNextItem != nil
oTree_1:Select( oNextItem )
IF oNextItem:Cargo[ 2 ] = oTreeLast:Cargo[ 2 ]
lRet := .F.
ENDIF
ELSE
lRet := .F.
ENDIF
RETURN lRet
*+--------------------------------------------------------------------
*+
*+ Static Function EndwithSlash()
*+
*+ Called from ( phone3.prg ) 1 - static procedure gettargetfolder()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION EndwithSlash( cString )
LOCAL nPosi
IF !EMPTY( cString )
nPosi := RAT( "\", cString )
IF nPosi = LEN( cString )
ELSE
cString += "\"
ENDIF
cString := STRTRAN( cString, "\\", "\", 3 )
ENDIF
RETURN cString
// ************************* include in DUALGRID.PRG **************************
#ifdef use_TGrid
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoCopySingle()
*+
*+ Called from ( phone3.prg ) 1 - static procedure dotreerecursiv()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoCopySingle( oDirFolder, cTarget, lMove )
LOCAL hGrid := oGrid:hwnd // GetControlHandle( "Grid_1", "IPHONE" )
LOCAL oNewSH := CreateObject( "Shell.Application" )
LOCAL oTarget := oNewSH:NameSpace( cTarget )
LOCAL xFlag := FOF_SIMPLEPROGRESS
LOCAL nState := hb_BitOr( LVIS_SELECTED, LVIS_FOCUSED )
LOCAL nMask := hb_BitOr( LVIS_SELECTED, LVIS_FOCUSED )
LOCAL aFiles := {}
LOCAL oFile, cFile, xCount, nCount
LOCAL i, iMax, nSkip := 0
DEFAULT lMove := .F.
iMax := oDirFolder:Count
FOR i := 1 TO iMax
SYSrefresh()
// if Checkbox is marked
// IF IPHONE.Grid_1.CheckBoxItem( i ) = .T.
// get Item Object
oFile := oDirFolder:Item( i - 1 )
IF lMove = .T.
// move single Object file
// https://learn.microsoft.com/de-de/windows/win32/shell/folder-movehere
oTarget:MoveHere( oFile, xFlag )
ELSE
// copy single Object file
// https://learn.microsoft.com/de-de/windows/win32/shell/folder-copyhere
oTarget:CopyHere( oFile, xFlag )
ENDIF
// wait until all files are written
xCount := 0
DO WHILE .T.
// compare if file is written
nCount := oTarget:items() :Count()
IF nCount + nSkip >= i
EXIT
ENDIF
hb_idleSleep( 0.1 )
xCount ++
IF xCount > 50
EXIT
ENDIF
ENDDO
// scroll GRID if need
LV_SETITEMSTATE( hGrid, i, nState, nMask )
LV_EnsureVisible( hGrid, i )
// ELSE
// // Skip un-maked
// nSkip ++
// ENDIF
NEXT
// clean up
hb_idleSleep( 0.5 )
oTarget := NIL
oNewSH := NIL
SYSrefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function CompareFile()
*+
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION CompareFile( aX, aY, lUp )
LOCAL cName1, cName2
LOCAL lRet
DEFAULT lUp := .T.
cName1 := LOWER( FindExt( aX ) + FindName( aX ) )
cName2 := LOWER( FindExt( aY ) + FindName( aY ) )
IF lUp = .T.
lRet := cName1 < cName2
ELSE
lRet := cName1 > cName2
ENDIF
RETURN ( lRet )
*+--------------------------------------------------------------------
*+
*+ Static Function FindName()
*+
*+ Called from ( phone3.prg ) 2 - static function comparefile()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION FindName( filename )
LOCAL nPosi := RAT( ".", filename )
RETURN SUBSTR( filename, 1, nPosi - 1 )
*+--------------------------------------------------------------------
*+
*+ Static Function FindExt()
*+
*+ Called from ( phone3.prg ) 2 - static function comparefile()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION FindExt( filename )
LOCAL nPosi := RAT( ".", filename )
RETURN UPPER( SUBSTR( filename, nPosi + 1, LEN( filename ) ) )
*+--------------------------------------------------------------------
*+
*+ Static Procedure SayBar()
*+
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SayBar( cText, nPart )
RETURN
#include "TGRID.PRG"
#include "HB_FUNC.PRG"
#endif
*+ EOF: PHONE3.PRG
... but still need to "optimize" (DblCkick/Click to expand)
