Utilizando el control TreeView (4/4)

Cuarta y última parte de una serie de códigos de ejemplos sobre como utilizar el control TreeView en VFP, escritos por el turco Cetin Basoz (Microsoft Visual FoxPro MVP 1999-2010).

* Define some constant
#DEFINE tvwFirst     0
#DEFINE tvwLast      1
#DEFINE tvwNext      2
#DEFINE tvwPrevious  3
#DEFINE tvwChild     4
#DEFINE cnLOG_PIXELS_X 88
#DEFINE cnLOG_PIXELS_Y 90
* 1440 twips por pulgadas
#DEFINE cnTWIPS_PER_INCH 1440

oForm = CREATEOBJECT('myForm')
oForm.SHOW
READ EVENTS

DEFINE CLASS myForm AS FORM
  HEIGHT = 640
  WIDTH = 800
  AUTOCENTER = .T.
  CAPTION = "TreeView - TestPad"
  NAME = "myForm"

  *-- Node object reference
  nodx = .F.
  nxtwips = .F.
  nytwips = .F.

  ADD OBJECT oletreeview AS OLECONTROL WITH ;
    TOP = 0, LEFT = 0, HEIGHT = 600, WIDTH = 750, ;
    ANCHOR = 15, NAME = "OleTreeView", ;
    OLECLASS = 'MSComCtlLib.TreeCtrl'

  ADD OBJECT oleimageslist AS OLECONTROL WITH ;
    TOP = 0, LEFT = 0, HEIGHT = 100, WIDTH = 100, ;
    NAME = "oleImagesList",;
    OLECLASS = 'MSComCtlLib.ImageListCtrl'

  *-- Fill the tree values
  PROCEDURE filltree
    LPARAMETERS tcDirectory, tcImage
    THIS.SHOW
    CREATE CURSOR crsNodes (NodeKey c(15), ParentKey c(15), NodeText m, NewParent c(15))
    LOCAL oNode
    WITH THIS.oletreeview.nodes
      oNode=.ADD(,tvwFirst,"root"+PADL(.COUNT,3,'0'),tcDirectory,tcImage)
    ENDWITH
    INSERT INTO crsNodes (NodeKey, ParentKey, NodeText) VALUES (oNode.KEY, '',oNode.TEXT)
    THIS._SubFolders(oNode)

  ENDPROC

  PROCEDURE pixeltotwips

    *-- Code for PixelToTwips method
    LOCAL liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY

    * Declare some Windows API functions.
    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDC IN WIN32API INTEGER iHDC
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER iHDC, INTEGER iIndex

    * Get a device context for VFP.
    liHWnd = GetActiveWindow()
    liHDC = GetDC(liHWnd)

    * Get the pixels per inch.
    liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
    liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)

    * Get the twips per pixel.
    THISFORM.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THISFORM.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
    RETURN

  ENDPROC

  *-- Collect subfolders
  PROCEDURE _SubFolders
    LPARAMETERS oNode
    LOCAL nChild, oNodex
    lcFolder = oNode.FULLPATH
    lcFolder = STRTRAN(lcFolder,":\\",":\")
    oFS = CREATEOBJECT('Scripting.FileSystemObject')
    oFolder = oFS.GetFolder(lcFolder)
    WITH THISFORM.oletreeview
      lnIndent = 0
      lnIndex = oNode.INDEX
      DO WHILE lnIndex # oNode.Root.INDEX ;
          AND TYPE('.nodes(lnIndex).Parent')='O' ;
          AND !ISNULL(.nodes(lnIndex).PARENT)
        lnIndex = .nodes(lnIndex).PARENT.INDEX
        lnIndent = lnIndent + 1
      ENDDO
      lcChildKeyPrefix = 'L'+PADL(lnIndent,3,'0')+'_'
    ENDWITH
    WITH THISFORM.oletreeview.nodes
      IF oNode.Children > 0
        IF oNode.CHILD.KEY = oNode.KEY+"dummy"
          .REMOVE(oNode.CHILD.INDEX)
          FOR EACH oSubFolder IN oFolder.Subfolders
            INSERT INTO crsNodes ;
              (NodeKey, ParentKey, NodeText) ;
              VALUES ;
              (lcChildKeyPrefix+' '+PADL(RECCOUNT('crsNodes')+1,5,'0'), ;
              oNode.KEY, oSubFolder.PATH)
            oNodex = .ADD(oNode.KEY, tvwChild, ;
              crsNodes.NodeKey, oSubFolder.NAME, "ClosedFolder","OpenFolder" )
            oNodex.ExpandedImage = "OpenFolder"
            IF oSubFolder.NAME # "System Volume Information" AND oSubFolder.Subfolders.COUNT > 0
              oNodex = .ADD(crsNodes.NodeKey, tvwChild, ;
                crsNodes.NodeKey+"dummy", "dummy", "ClosedFolder","OpenFolder" )
            ENDIF
          ENDFOR
        ENDIF
      ELSE
        IF oFolder.Subfolders.COUNT > 0
          oNodex = .ADD(oNode.KEY, tvwChild, ;
            oNode.KEY+"dummy", "dummy", "ClosedFolder","OpenFolder" )
        ENDIF
      ENDIF
    ENDWITH
  ENDPROC

  PROCEDURE QUERYUNLOAD
    THISFORM.nodx = .NULL.
    CLEAR EVENTS
  ENDPROC

  PROCEDURE INIT
    THIS.pixeltotwips()
    SET TALK OFF
    * Check to see if OCX installed and loaded.
    IF TYPE("THIS.oleTreeView") # "O" OR ISNULL(THIS.oletreeview)
      RETURN .F.
    ENDIF
    IF TYPE("THIS.oleImagesList") # "O" OR ISNULL(THIS.oleimageslist)
      RETURN .F.
    ENDIF
    lcIconPath = HOME(0) + "Graphics\Icons\"
    WITH THIS.oleimageslist
      .ImageHeight = 32
      .ImageWidth = 32
      .ListImages.ADD(,"OpenFolder",LOADPICTURE(lcIconPath+"Win95\openfold.ico"))
      .ListImages.ADD(,"ClosedFolder",LOADPICTURE(lcIconPath+"Win95\clsdfold.ico"))
      .ListImages.ADD(,"Drive",LOADPICTURE(lcIconPath+"Computer\drive01.ico"))
      .ListImages.ADD(,"Floppy",LOADPICTURE(lcIconPath+"Win95\35floppy.ico"))
      .ListImages.ADD(,"NetDrive",LOADPICTURE(lcIconPath+"Win95\drivenet.ico"))
      .ListImages.ADD(,"CDDrive",LOADPICTURE(lcIconPath+"Win95\CDdrive.ico"))
      .ListImages.ADD(,"RAMDrive",LOADPICTURE(lcIconPath+"Win95\desktop.ico"))
      .ListImages.ADD(,"Unknown",LOADPICTURE(lcIconPath+"Misc\question.ico"))
    ENDWITH

    WITH THIS.oletreeview
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .imagelist = THIS.oleimageslist.OBJECT
      .PathSeparator = '\'
      .OLEDRAGMODE = 1
      .OLEDROPMODE = 1
    ENDWITH

    oFS = CREATEOBJECT('Scripting.FileSystemObject')
    LOCAL ARRAY aDrvTypes[7]
    aDrvTypes[1]="Unknown"
    aDrvTypes[2]="Floppy"
    aDrvTypes[3]="Drive"
    aDrvTypes[4]="NetDrive"
    aDrvTypes[5]="CDDrive"
    aDrvTypes[6]="RAMDrive"

    FOR EACH oDrive IN oFS.Drives
      IF oDrive.IsReady
        THIS.filltree(oDrive.Rootfolder.PATH, aDrvTypes[oDrive.DriveType+1])
      ENDIF
    ENDFOR
  ENDPROC

  PROCEDURE oletreeview.Expand
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    THISFORM._SubFolders(NODE)
    NODE.ensurevisible
  ENDPROC

  PROCEDURE oletreeview.NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    THIS.DropHighlight = .NULL.
  ENDPROC

  PROCEDURE oletreeview.MOUSEDOWN
    *** ActiveX Control Event ***
    LPARAMETERS BUTTON, SHIFT, x, Y
    WITH THISFORM
      oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
      IF TYPE("oHitTest")= "O" AND !ISNULL(oHitTest)
        THIS.SELECTEDITEM = oHitTest
      ENDIF
      .nodx = THIS.SELECTEDITEM
    ENDWITH
    oHitTest = .NULL.
  ENDPROC

  PROCEDURE oletreeview.OLEDRAGOVER
    *** ActiveX Control Event ***
    LPARAMETERS DATA, effect, BUTTON, SHIFT, x, Y, state
    oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
    IF TYPE("oHitTest")= "O"
      THIS.DropHighlight = oHitTest
    ENDIF
  ENDPROC

  PROCEDURE oletreeview.OLEDRAGDROP
    *** ActiveX Control Event ***
    LPARAMETERS DATA, effect, BUTTON, SHIFT, x, Y
    IF DATA.GETFORMAT(1)     &&CF_TEXT
      WITH THIS
        IF !ISNULL(THISFORM.nodx) AND TYPE(".DropHighLight") = "O" AND !ISNULL(.DropHighlight)
          loSource = THISFORM.nodx
          loTarget = .DropHighlight
          IF loSource.KEY # loTarget.KEY AND TYPE('loSource.Parent') = 'O'
            lcSourceParentKey = loSource.PARENT.KEY
            lcTargetParentKey = loTarget.PARENT.KEY
            IF SUBSTR(lcSourceParentKey,1,AT('_',lcSourceParentKey)-1) == ;
                SUBSTR(lcTargetParentKey,1,AT('_',lcTargetParentKey)-1)
              lcSourceKey = IIF(lcSourceParentKey == lcTargetParentKey,'',;
                IIF(SHIFT=1,'mv','cp'))+loSource.KEY
              lcSourceText = loSource.TEXT
              llRemoveSource = (lcSourceParentKey == lcTargetParentKey OR SHIFT=1)

              * Check here for children repopulation since we're simulating with existing directories
              * llGetChildren should be false for copy-move from another parent dir
              llGetChildren  = (lcSourceParentKey == lcTargetParentKey)

              IF llRemoveSource
                .nodes.REMOVE(loSource.INDEX)
              ENDIF
              * Check if node exists already
              IF TYPE('.Nodes(lcSourceKey)') # 'O'
                oNode=.nodes.ADD(loTarget.KEY,tvwPrevious,lcSourceKey,lcSourceText,;
                  "ClosedFolder","OpenFolder")
                .SELECTEDITEM = oNode
                IF llGetChildren
                  THISFORM._SubFolders(oNode)
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDWITH
    ENDIF
    THIS.DropHighlight = .NULL.
  ENDPROC

ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.