25 de mayo de 2011

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.

Utilizando el control TreeView (3/4)

Tercera 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 tvwFirst    0
#DEFINE tvwLast    1
#DEFINE tvwNext    2
#DEFINE tvwPrevious    3
#DEFINE tvwChild    4

#DEFINE cnLOG_PIXELS_X 88
#DEFINE cnLOG_PIXELS_Y 90
#DEFINE cnTWIPS_PER_INCH 1440

TEXT to myMenu noshow
Lparameters toNode,toForm

DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF shortcut PROMPT "Key"
DEFINE BAR 2 OF shortcut PROMPT "Text"
DEFINE BAR 3 OF shortcut PROMPT "Fullpath"
DEFINE BAR 4 OF shortcut PROMPT "Index"
DEFINE BAR 5 OF shortcut PROMPT "New Item"
ON SELECTION BAR 1 OF shortcut ;
    wait window toNode.Key timeout 2
ON SELECTION BAR 2 OF shortcut  ;
    wait window toNode.Text timeout 2
ON SELECTION BAR 3 OF shortcut  ;
    wait window toNode.Fullpath timeout 2
ON SELECTION BAR 4 OF shortcut  ;
    wait window Transform(toNode.Index) timeout 2
ON SELECTION BAR 5 OF shortcut toForm.ShowIt(toNode)
ACTIVATE POPUP shortcut

ENDTEXT

*StrToFile(m.myMenu,'myTVShcut.mpr')

oForm = CREATEOBJECT('myForm')
WITH oForm
  .ADDOBJECT('Tree','myTreeView')
  .ADDOBJECT('Lister','Lister')
  WITH .Tree
    .WIDTH = 700
    .HEIGHT = 600
    .Nodes.ADD(,0,"root0",'Main node 1')
    .Nodes.ADD(,0,"root1",'Main node 2')
    .Nodes.ADD(,0,"root2",'Main node 3')
    .Nodes.ADD('root1',4,"child11",'Child11')
    .Nodes.ADD('root1',4,"child12",'Child12')
    .Nodes.ADD('root2',4,"child21",'Child22')
    .Nodes.ADD('child21',3,"child20",'Child21')
    oNodx=.Nodes.ADD('child11',4,"child111",'child113')
    oNodx.Bold=.T.
    .Nodes.ADD('child111',3,"child112",'child112')
    .Nodes.ADD('child112',3,"child113",'child111')

    .Nodes.ADD('child12',4,"child121",'child121')
    .Nodes.ADD('child12',4,"child122",'child122')

    .Nodes.ADD('child112',4,"child1121",'child1121')
    .Nodes.ADD('child112',4,"child1122",'child1122')
    .Nodes.ADD('child112',4,"child1123",'child1123')
    .Nodes.ADD('child112',4,"child1124",'child1124')
    .Nodes.ADD('child112',4,"child1125",'child1125')

    .Nodes.ADD('child1121',4,"child11211",'child11211')
    .Nodes.ADD('child1121',4,"child11212",'child11212')

    .Nodes.ADD('child11211',4,"child112111",'child112111')
    .Nodes.ADD('child11212',4,"child112121",'child112121 last added')
    .VISIBLE = .T.
    .Nodes(.Nodes.COUNT).Ensurevisible
    WITH .FONT
      .SIZE = 12
      .NAME = 'Times New Roman'
      .Bold = .F.
      .Italic = .T.
    ENDWITH
  ENDWITH
  .Lister.LEFT = .WIDTH - .Lister.WIDTH
  .lister.VISIBLE = .T.
  .SHOW()
ENDWITH
READ EVENTS

FUNCTION TVLister
  LPARAMETERS toTV
  LOCAL lnIndex,lnLastIndex
  WITH toTV
    lnIndex     = .Nodes(1).Root.FirstSibling.INDEX
    lnLastIndex = .Nodes(1).Root.LastSibling.INDEX
    _GetSubNodes(lnIndex,toTV,lnIndex)
    DO WHILE lnIndex # lnLastIndex
      lnIndex = .Nodes(lnIndex).NEXT.INDEX
      _GetSubNodes(lnIndex,toTV,lnIndex)
    ENDDO
  ENDWITH

FUNCTION _GetSubNodes
  LPARAMETERS tnIndex, toTV, tnRootIndex
  LOCAL lnIndex, lnLastIndex
  WITH toTV
    WriteNode(tnIndex,toTV, tnRootIndex)
    IF .Nodes(tnIndex).Children > 0
      lnIndex  = .Nodes(tnIndex).CHILD.INDEX
      lnLastIndex = .Nodes(tnIndex).CHILD.LastSibling.INDEX
      _GetSubNodes(lnIndex,toTV,tnRootIndex)
      DO WHILE lnIndex # lnLastIndex
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        _GetSubNodes(lnIndex,toTV,tnRootIndex)
      ENDDO
    ENDIF
  ENDWITH

FUNCTION WriteNode
  LPARAMETERS tnCurIndex, toTV,tnRootIndex
  LOCAL lnRootIndex, lnIndex, lcPrefix, lcKey, lnLevel
  lnIndex = tnCurIndex

  WITH toTV
    lcPrefix = '+-' + .Nodes(lnIndex).TEXT
    lnLevel = 0
    DO WHILE lnIndex # tnRootIndex
      lnIndex = .Nodes(lnIndex).PARENT.INDEX
      lcPrefix = IIF(.Nodes(lnIndex).LastSibling.INDEX = lnIndex,' ','|')+SPACE(3)+lcPrefix
      lnLevel = lnLevel + 1
    ENDDO
    ? lcPrefix
  ENDWITH

FUNCTION WalkTree
  LPARAMETERS oNode,lnIndent,tlPlus
  ? IIF(tlPlus,'+','')+REPLICATE(CHR(9),lnIndent)+oNode.TEXT
  IF !ISNULL(oNode.CHILD)
    WalkTree(oNode.CHILD,lnIndent+1,.T.)
  ENDIF
  IF !ISNULL(oNode.NEXT)
    WalkTree(oNode.NEXT,lnIndent,.F.)
  ENDIF
  RETURN
ENDFUNC

DEFINE CLASS myForm AS FORM
  AUTOCENTER = .T.
  HEIGHT = 640
  WIDTH = 800

  nxtwips = .F.
  nytwips = .F.

  PROCEDURE QUERYUNLOAD
    CLEAR EVENTS
  ENDPROC

  PROCEDURE ShowIt
    LPARAMETERS toNode
    MESSAGEBOX("Form method called with " + toNode.FULLPATH)
  ENDPROC

  PROCEDURE INIT
    *-- 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.
    THIS.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THIS.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
    RETURN
  ENDPROC


  PROCEDURE CheckRest
    LPARAMETERS tnIndex, tlCheck, toTreeView
    LOCAL lnIndex, lnLastIndex
    WITH toTreeView
      .Nodes(tnIndex).Checked = tlCheck
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        lnLastIndex = .Nodes(tnIndex).CHILD.LastSibling.INDEX
        THIS.CheckRest(lnIndex, tlCheck, toTreeView)
        DO WHILE lnIndex # lnLastIndex
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          THIS.CheckRest(lnIndex, tlCheck, toTreeView)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC

ENDDEFINE

DEFINE CLASS myTreeView AS OLECONTROL
  OLEDRAGMODE = 1
  OLEDROPMODE = 1
  NAME = "OleTreeView"
  OLECLASS = 'MSComCtlLib.TreeCtrl'

  PROCEDURE INIT
    WITH THIS
      .OBJECT.CheckBoxes = .T.
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
    ENDWITH
  ENDPROC
  PROCEDURE NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    MESSAGEBOX(NODE.FULLPATH + CHR(13) +TRANS(NODE.INDEX),0,"NodeClick",2000)
  ENDPROC

  PROCEDURE MOUSEDOWN
    LPARAMETERS BUTTON, SHIFT, x, Y
    IF BUTTON=2
      lcWhere = ''
      oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
      IF TYPE("oNode")= "O" AND !ISNULL(oNode)
        *        DO myTVShcut.mpr with oNode
        EXECSCRIPT(m.MyMenu, oNode, THISFORM)
      ENDIF
    ENDIF
  ENDPROC

  PROCEDURE MOUSEUP
    LPARAMETERS BUTTON, SHIFT, x, Y
    *!*      if button=2
    *!*          nodefault
    *!*          Wait window 'Right click occured in Mup' timeout 2
    *!*      endif
    IF BUTTON=1
      oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
      IF TYPE("oNode")= "O" AND !ISNULL(oNode)
        IF oNode.KEY # 'root1'
          oNode.Checked = .F.
        ELSE
          THISFORM.CheckRest(oNode.INDEX,oNode.Checked,THIS)
        ENDIF
      ENDIF
    ENDIF
  ENDPROC

  *!*      Procedure NodeCheck
  *!*    *** ActiveX Control Event ***
  *!*    Lparameters node,dummy
  *!*    IF node.Key = 'root1'
  *!*    thisform.CheckRest(node.Index,node.Checked,this)
  *!*    endif
  *!*    endproc

  PROCEDURE _SubNodes
    LPARAMETERS tnIndex, tnLevel
    LOCAL lnIndex
    lcFs = ''
    WITH THIS
      ? IIF(tnLevel=0,'',REPLICATE(CHR(9),tnLevel))+.Nodes(tnIndex).TEXT, "[Actual index :"+TRANS(tnIndex)+"]"
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        ._SubNodes(lnIndex,tnLevel+1)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          ._SubNodes(lnIndex,tnLevel+1)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC

  PROCEDURE ExpandAll
    LPARAMETERS tnIndex
    LOCAL lnIndex
    WITH THIS
      .Nodes(tnIndex).Expanded = .T.
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        .ExpandAll(lnIndex)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          .ExpandAll(lnIndex)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC
ENDDEFINE

DEFINE CLASS Lister AS COMMANDBUTTON
  CAPTION = 'Listado'
  HEIGHT = 32
  WIDTH = 100

  PROCEDURE CLICK
    ACTIVATE SCREEN
    TvLister(THISFORM.Tree)
    WITH THISFORM.Tree
      *  WalkTree(.Nodes(1),0)
      *    .ExpandAll(.SelectedItem.Index)
    ENDWITH
  ENDPROC

  PROCEDURE click1
    ACTIVATE SCREEN
    CLEAR
    LOCAL lnIndex
    WITH THISFORM.Tree
      lnIndex = .Nodes(1).Root.FirstSibling.INDEX
      ._SubNodes(lnIndex,0)
      DO WHILE lnIndex # .Nodes(1).Root.LastSibling.INDEX
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        ._SubNodes(lnIndex,0)
      ENDDO
    ENDWITH
  ENDPROC
ENDDEFINE

Gracias Cetin por compartir y autorizar esta publicación.

Utilizando el control TreeView (2/4)

Segunda 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).
SELECT PADR('Customer_'+cust_id,20) AS NodeID, ;
  PADR('',20) AS ParentID, ;
  PADR(Company,100) AS NodeText, ;
  0 AS LEVEL ;
  FROM (HOME(2)+'data\customer') ;
  UNION ;
  SELECT PADR('Orders_'+order_id,20) AS NodeID, ;
  PADR('Customer_'+c.cust_id,20) AS ParentID, ;
  PADR(ALLTRIM(TRANSFORM(order_id))+":"+TRANSFORM(Order_Date),100) AS NodeText, ;
  1 AS LEVEL ;
  FROM (HOME(2)+'data\Orders') o ;
  INNER JOIN (HOME(2)+'data\customer') c ON o.cust_id == c.cust_id ;
  UNION ;
  SELECT 'OrdItems_'+oi.order_id+'_'+PADL(line_no,3,'0') AS NodeID, ;
  'Orders_'+o.order_id AS ParentID, ;
  TRANSFORM(oi.line_no)+':'+p.Prod_Name-(' ['+TRANSFORM(oi.Quantity)+']') AS NodeText, ;
  2 AS LEVEL ;
  FROM (HOME(2)+'data\OrdItems') oi ;
  INNER JOIN (HOME(2)+'data\Orders') o ON oi.order_id == o.order_id ;
  INNER JOIN (HOME(2)+'data\customer') c ON o.cust_id == c.cust_id ;
  INNER JOIN (HOME(2)+'data\products') p ON oi.product_id == p.product_id ;
  ORDER BY LEVEL ;
  INTO CURSOR myTree ;
  nofilter

#DEFINE tvwFirst 0
#DEFINE tvwLast 1
#DEFINE tvwNext 2
#DEFINE tvwPrevious 3
#DEFINE tvwChild 4

PUBLIC oForm
oForm = CREATEOBJECT('myTreeForm','myTree')
oForm.SHOW

DEFINE CLASS myTreeForm AS FORM
  HEIGHT = 640
  WIDTH = 800
  Autocenter = .T.
  CAPTION = "TreeView - TestPad"

  nxtwips = 0
  nytwips = 0
  cursorbehind = ''

  ADD OBJECT TreeView AS OLECONTROL WITH ;
    HEIGHT = 640, WIDTH = 800, ;
    anchor = 15, OLECLASS = 'MSComCtlLib.TreeCtrl'

  PROCEDURE INIT
    LPARAMETERS tcCursorName
    WITH THIS.TreeView
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
      .SCROLL = .T.
      .OLEDRAGMODE = 0
      .OLEDROPMODE = 0
    ENDWITH
    THIS.cursorbehind = m.tcCursorName
    THIS.PixelToTwips()
    THIS.Populate()
  ENDPROC

  PROCEDURE Populate
    SELECT (THIS.cursorbehind)
    WITH THIS.TreeView.Nodes
      SCAN
        IF EMPTY(ParentID)
          oNode = .ADD(,tvwFirst,TRIM(NodeID),TRIM(NodeText))
          oNode.Bold = .T.
        ELSE
          oNode = .ADD(TRIM(ParentID),tvwChild,TRIM(NodeID) ,TRIM(NodeText))
          IF OCCURS('\',oNode.FULLPATH)=1
            oNode.BACKCOLOR = 0x00FFFF
            oNode.FORECOLOR = 0xFF0000
          ENDIF
          IF OCCURS('\',oNode.FULLPATH)=2
            oNode.FORECOLOR = 0x0000FF
          ENDIF
        ENDIF
      ENDSCAN
    ENDWITH
  ENDPROC

  PROCEDURE PixelToTwips
    LOCAL liHDC, liPixelsPerInchX, liPixelsPerInchY
    #DEFINE cnLOG_PIXELS_X 88
    #DEFINE cnLOG_PIXELS_Y 90
    #DEFINE cnTWIPS_PER_INCH 1440

    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDC IN WIN32API INTEGER iHDC
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER iHDC, INTEGER iIndex

    liHDC = GetDC(GetActiveWindow())

    liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
    liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)

    THIS.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
    THIS.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
  ENDPROC

  PROCEDURE TreeView.MOUSEMOVE
    LPARAMETERS BUTTON, SHIFT, x, Y
    WITH THISFORM
      oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
      IF TYPE("oHitTest")= "O" AND !ISNULL(oHitTest)
        WAIT WINDOW NOWAIT oHitTest.FULLPATH
      ENDIF
    ENDWITH
    oHitTest = .NULL.
  ENDPROC

  PROCEDURE TreeView.NodeClick
    LPARAMETERS oNode
    LOCAL aNodeInfo[1]
    IF ALINES(aNodeInfo,oNode.KEY,1,'_') = 2 && Customer or orders
      IF LOWER(aNodeInfo[1]) == 'customer'
        SELECT * FROM customer WHERE cust_id = aNodeInfo[2]
      ELSE
        SELECT * FROM orders WHERE VAL(order_id) = VAL(aNodeInfo[2])
      ENDIF
    ELSE
      SELECT * FROM orditems ;
        WHERE VAL(order_id) = VAL(aNodeInfo[2]) AND line_no = VAL(aNodeInfo[3])
    ENDIF
  ENDPROC
ENDDEFINE
Gracias Cetin por compartir y autorizar esta publicación.

Utilizando el control TreeView (1/4)

Primera 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 tvwFirst 0
#DEFINE tvwLast 1
#DEFINE tvwNext 2
#DEFINE tvwPrevious 3
#DEFINE tvwChild 4

oForm = CREATEOBJECT('myForm')
WITH oForm
  .ADDOBJECT('Tree','myTreeView')
  .ADDOBJECT('Lister','Lister')
  WITH .Tree
    .Nodes.ADD(,0,"root1",'Main node 2')
    .Nodes.ADD(,0,"root2",'Main node 3')
    .Nodes.ADD('root1',4,"child11",'Child11')
    .Nodes.ADD('root1',4,"child12",'Child12')
    .Nodes.ADD('root2',4,"child21",'Child22')
    .Nodes.ADD('child21',3,"child20",'Child21')
    .Nodes.ADD('child11',4,"child111",'child113')
    .Nodes.ADD('child111',3,"child112",'child112')
    .Nodes.ADD('child112',3,"child113",'child111')
    .Nodes.ADD('root1',3,"root0",'Main node 1')
    .VISIBLE = .T.
  ENDWITH
  .Lister.LEFT = .WIDTH - .Lister.WIDTH
  .Lister.VISIBLE = .T.
  .SHOW()
ENDWITH
READ EVENTS

DEFINE CLASS myForm AS FORM
  AUTOCENTER = .T.
  HEIGHT = 640
  WIDTH = 800
  PROCEDURE QUERYUNLOAD
    CLEAR EVENTS
  ENDPROC
ENDDEFINE

DEFINE CLASS myTreeView AS OLECONTROL
  OLEDRAGMODE = 1
  OLEDROPMODE = 1
  NAME = "OleTreeView"
  OLECLASS = 'MSComCtlLib.TreeCtrl'
  HEIGHT = 600
  WIDTH = 700

  PROCEDURE INIT
    WITH THIS
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .PathSeparator = '\'
    ENDWITH
  ENDPROC

  PROCEDURE NodeClick
    *** ActiveX Control Event ***
    LPARAMETERS NODE
    NODE.ensurevisible
    MESSAGEBOX(NODE.FULLPATH,TRANS(NODE.INDEX))
  ENDPROC

  PROCEDURE _SubNodes
    LPARAMETERS tnIndex, tnLevel
    LOCAL lnIndex
    lcFs = ''
    WITH THIS
      ? IIF(tnLevel=0,'',REPLICATE(CHR(9),tnLevel))+.Nodes(tnIndex).TEXT, "[Actual index :"+TRANS(tnIndex)+"]"
      IF .Nodes(tnIndex).Children > 0
        lnIndex  = .Nodes(tnIndex).CHILD.INDEX
        ._SubNodes(lnIndex,tnLevel+1)
        DO WHILE lnIndex # .Nodes(tnIndex).CHILD.LastSibling.INDEX
          lnIndex = .Nodes(lnIndex).NEXT.INDEX
          ._SubNodes(lnIndex,tnLevel+1)
        ENDDO
      ENDIF
    ENDWITH
  ENDPROC
ENDDEFINE

DEFINE CLASS lister AS COMMANDBUTTON
  CAPTION = 'Listado'
  HEIGHT = 32
  WIDTH = 100

  PROCEDURE CLICK
    ACTIVATE SCREEN
    CLEAR
    LOCAL lnIndex
    WITH THISFORM.Tree
      lnIndex = .Nodes(1).Root.FirstSibling.INDEX
      ._SubNodes(lnIndex,0)
      DO WHILE lnIndex # .Nodes(1).Root.LastSibling.INDEX
        lnIndex = .Nodes(lnIndex).NEXT.INDEX
        ._SubNodes(lnIndex,0)
      ENDDO
    ENDWITH
  ENDPROC
ENDDEFINE
Gracias Cetin por compartir y autorizar esta publicación.

10 de mayo de 2011

Seleccionar uno o mas registros aleatoriamente

Tomemos como ejemplo que deseamos seleccionar aleatoriamente un solo Cliente de la tabla Northwind!Customers, para ello nos ayudaremos con la función RAND() de VFP:
*-- Por primera vez tomo una semilla a partir del reloj del sistema. 
*-- Ver la ayuda de la función RAND()
RAND(-1)

SELECT TOP 1 *, RAND() AS Rnd ;
 FROM (HOME(2) + "Northwind\Customers") ;
 ORDER BY Rnd
En el caso de que necesitemos seleccionar mas clientes aleatoriamente de la tabla Customers, por ejemplo 5 clientes :
SELECT TOP 5 *, RAND() AS Rnd ;
 FROM (HOME(2) + "Northwind\Customers") ;
 ORDER BY Rnd