Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
MoverBar functionality with the Treeview control
Message
From
12/05/2001 12:05:01
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
11/05/2001 16:04:40
Dave Nantais
Light speed database solutions
Ontario, Canada
General information
Forum:
Visual FoxPro
Category:
ActiveX controls in VFP
Miscellaneous
Thread ID:
00506391
Message ID:
00506617
Views:
17
This message has been marked as the solution to the initial question of the thread.
>With a moverbar within a listbox i can allow users to re-order a list of items.
>How can I achieve this functionality with the ActiveX Treeview of Listview control. I want users to be able to drag and drop a node on a Treeview control.
>
>Thanks In Advance...

Warning : Long content
Hi Dave,
Basically what you do is remove the source node and insert it with a tvwPrevious relation to target node :
* Define some constants.
#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
* 1440 twips per inch
oForm = createobject('myForm')
oForm.Show
Read events

Define CLASS myForm AS form


  Top = 2
  Left = 2
  Height = 315
  Width = 628
  DoCreate = .T.
  Caption = "TreeView - testpad"
  BackColor = RGB(192,192,192)
  Name = "myForm"

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


  Add OBJECT oletreeview AS olecontrol WITH ;
    Top = 12, ;
    Left = 0, ;
    Height = 296, ;
    Width = 624, ;
    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
  This.show
  Create cursor crsNodes (NodeKey c(15), ParentKey c(15), NodeText m, NewParent c(15))
  With THIS.oletreeview.nodes
    oNode=.add(,tvwFirst,"root"+padl(.count,3,'0'),tcDirectory,"Drive")
  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
      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.originalhgt = this.Height
  This.originalwdt = this.Width
  Thisform.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(3)+'Graphics\Icons\Win95'
  With this.oleimageslist
    .ImageHeight = 16
    .ImageWidth = 16
    .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"\openfold.ico"))
    .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"\clsdfold.ico"))
    .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"\drive.ico"))
    .ListImages.Add(,"Floppy",LoadPicture(lcIconPath+"\35floppy.ico"))
    .ListImages.Add(,"NetDrive",LoadPicture(lcIconPath+"\drivenet.ico"))
    .ListImages.Add(,"CDDrive",LoadPicture(lcIconPath+"\CDdrive.ico"))
  Endwith
  With THIS.oletreeview
    .linestyle =1
    .labeledit =1
    .indentation = 5
    .imagelist = this.oleimageslist.object
    .PathSeparator = '\'
    .OleDragMode = 1
    .OleDropMode = 1
  Endwith
  This.filltree("c:\")
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
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform