Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
The Node is always dropped onto First Node
Message
De
13/05/2000 11:00:38
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
 
À
13/05/2000 02:21:13
Shaheer Shamsi
Boston Education & Software Technologies
Mumbai, Inde
Information générale
Forum:
Visual FoxPro
Catégorie:
Contrôles ActiveX en VFP
Divers
Thread ID:
00369312
Message ID:
00369340
Vues:
19
Hi Shaheer,
This test form might help you. You'd need to have an imagelist control and add some icons to it or clear image props of nodes. It also demonstrates a fast loading "explorer like" directory tree using FileSystemObject :
**************************************************
*-- Form:         form1 (c:\ddrive\test\form\oletest2.scx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   01/22/00 02:51:00 PM
*
Define CLASS form1 AS form


  Top = 2
  Left = 2
  Height = 367
  Width = 628
  DoCreate = .T.
  Caption = "TreeView - Statusbar testpad"
  BackColor = RGB(192,192,192)
  Name = "Form1"
  lastrec = .F.

  *-- Node object reference
  nodx = .F.

  *-- Flag for drag operation
  lindrag = .F.
  indrag = .F.
  nxtwips = .F.
  nytwips = .F.
  originalhgt = .F.
  originalwdt = .F.

  *-- Fullpath of node clicked
  savenodevalue = .F.


  Add OBJECT oletreeview AS olecontrol WITH ;
    Top = 3, ;
    Left = 2, ;
    Height = 297, ;
    Width = 254, ;
    Name = "Oletreeview"


  Add OBJECT oleimageslist AS olecontrol WITH ;
    Top = 6, ;
    Left = 1, ;
    Height = 45, ;
    Width = 65, ;
    Name = "oleImagesList"


  Add OBJECT olecontrol2 AS olecontrol WITH ;
    Top = 349, ;
    Left = 0, ;
    Height = 18, ;
    Width = 628, ;
    Align = 2, ;
    Name = "Olecontrol2"


  Add OBJECT text1 AS textbox WITH ;
    OLEDragMode = 1, ;
    Height = 23, ;
    Left = 21, ;
    Top = 320, ;
    Width = 591, ;
    Name = "Text1"


  Add OBJECT edit1 AS editbox WITH ;
    Height = 296, ;
    Left = 285, ;
    Top = 6, ;
    Width = 326, ;
    Name = "Edit1"


  *-- Fill the tree values
  Procedure filltree
    Lparameters tcDirectory
    This.show
    #Define tvwFirst	0
    #Define tvwLast	1
    #Define tvwNext	2
    #Define tvwPrevious	3
    #Define tvwChild	4

    *tcDirectory = iif(oFolder.IsRootFolder(), substr(tcDirectory,1,len(tcDirectory)-1), tcDirectory)
    oNode=THIS.oletreeview.nodes.add(,tvwFirst,"TopKey",tcDirectory,"Drive")
    This._SubFolders(oNode)
    This.olecontrol2.panels(1).text = "Ready"
  Endproc


  Procedure pixeltotwips
    *-- Code for PixelToTwips method
    Local liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY
    * Define some constants.

    #Define cnLOG_PIXELS_X 88
    #Define cnLOG_PIXELS_Y 90
    #Define cnTWIPS_PER_INCH 1440
    * 1440 twips per inch

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

    lcFolder = oNode.Fullpath
    lcFolder = strtran(lcFolder,":\\",":\")
    oFS = CREATEOBJECT('Scripting.FileSystemObject')
    oFolder = oFS.GetFolder(lcFolder)
    With ThisForm.oletreeview.nodes
      If oNode.Children > 0
        If oNode.Child.Key = oNode.Key+"dummy"
          .Remove(oNode.Child.Index)
          nChild = 1
          For each oSubFolder in oFolder.Subfolders
            oNodex = .Add(oNode.Key, tvwChild, ;
              oNode.Key+padl(nChild,3,"0"), oSubFolder.name, "ClosedFolder" )
            oNodex.ExpandedImage = "OpenFolder"
            If oSubFolder.Name # "System Volume Information" and oSubFolder.Subfolders.Count > 0
              oNodex = .Add(oNode.Key+padl(nChild,3,"0"), tvwChild, ;
                oNode.Key+padl(nChild,3,"0")+"dummy", "dummy", "ClosedFolder" )
            Endif
            nChild = nChild+1
          Endfor
        Endif
      Else
        If oFolder.Subfolders.count > 0
          oNodex = .Add(oNode.Key, tvwChild, ;
            oNode.Key+"dummy", "dummy", "ClosedFolder" )
        Endif
      Endif
    Endwith
  Endproc


  Procedure QueryUnload
    Thisform.nodx = .null.
  Endproc


  Procedure Init
    This.originalhgt = this.Height
    This.originalwdt = this.Width
    Thisform.pixeltotwips()
    Set TALK OFF
    Wait WINDOW NOWAIT "Loading information. Please stand by..."
    * 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
    This.oletreeview.linestyle =1
    This.oletreeview.labeledit =1
    This.oletreeview.indentation = 5
    This.oletreeview.imagelist = this.oleimageslist.object
    This.filltree("c:\")
  Endproc


  Procedure Resize
    lnHgtRatio = this.Height / this.originalhgt
    lnWdtRatio = this.Width / this.originalwdt
    For each oControl in this.Controls
      With oControl
        .width = .width * lnWdtRatio
        .height = .height * lnHgtRatio
      Endwith
    Endfor
    This.originalhgt = this.Height
    This.originalwdt = this.Width
  Endproc


  Procedure addnode
  Endproc


  Procedure oletreeview.Expand
    *** ActiveX Control Event ***
    Lparameters node
    Thisform._SubFolders(node)
    Node.ensurevisible
  Endproc


  Procedure oletreeview.NodeClick
    *** OLE Control Event ***
    Lparameters node
    Thisform.text1.value = strtran(node.fullpath,":\\",":\")
    Thisform.savenodevalue = strtran(node.fullpath,":\\",":\")
    Node.ensurevisible
    Thisform.olecontrol2.panels(2).text = node.text
    * Show current children
    With this
      .DropHighlight = .null.
      If node.Children > 0
        Thisform.edit1.Value = "Current childs of this node :" + chr(13) + ;
          "-----------------------------" + chr(13) + Node.Child.Text
        lnIndex  = Node.Child.Index
        Do while lnIndex # Node.Child.LastSibling.Index
          Thisform.edit1.Value = thisform.edit1.Value + chr(13) + .nodes(lnIndex).Next.Text
          lnIndex = .nodes(lnIndex).Next.Index
        Enddo
      Endif

      lnIndent = 0
      lnIndex = Node.Index
      Do while lnIndex # Node.Root.Index
        lnIndex = .nodes(lnIndex).Parent.Index
        lnIndent = lnIndent + 1
      Enddo
    Endwith

    With thisform.olecontrol2
      .panels(3).text = strtran(node.fullpath,":\\",":\")
      .panels(1).text = node.key +"-"+ltrim(str(lnIndex))
    Endwith
  Endproc


  Procedure oletreeview.MouseDown
    *** OLE Control Event ***
    Lparameters button, shift, x, y
    Thisform.nodx = this.SelectedItem
    oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
    If type("oHitTest")= "O" and !isnull(oHitTest)
      Thisform.savenodevalue = strtran(oHitTest.fullpath,":\\",":\")
    Endif
    oHitTest = .null.
  Endproc


  Procedure oletreeview.OLEDragOver
    *** OLE 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
      If type("this.DropHighLight") = "O" and !isnull(this.DropHighlight)
        If type("thisform.SaveNodeValue") = "C" and ;
            Thisform.savenodevalue # strtran(this.DropHighlight.fullpath,":\\",":\")
          Thisform.edit1.Value = "Dropped "+thisform.savenodevalue+;
            " on "+strtran(this.DropHighlight.fullpath,":\\",":\")
        Else
          Thisform.edit1.Value = "Dropped "+Data.GetData(1)+" on "+this.DropHighlight.text
        Endif
      Endif
    Endif
    This.DropHighlight = .null.
  Endproc


  Procedure olecontrol2.Init
    This.panels(3).width = this.width - (this.panels(1).width+this.panels(2).width+5)
  Endproc


  Procedure text1.OLEDragDrop
    Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
    If oDataObject.Getformat(1)	&&CF_TEXT
      This.Value = oDataObject.GetData(1)
    Endif
  Endproc


Enddefine
*
*-- EndDefine: form1
**************************************************
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
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform