Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Add a treview, image control and browser
Message
From
23/05/2005 10:52:14
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
23/05/2005 10:30:36
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Environment versions
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01016749
Message ID:
01016757
Views:
23
This message has been marked as the solution to the initial question of the thread.
>I am doing a form in prg for the first time:
>how do I add a tree, image control and browser to it?
>
>
>	ADD OBJECT otree AS olecontrol WITH ;
>		Top = 35, ;
>		Left = 0, ;
>		Height = 213, ;
>		Width = 144, ;
>		Name = "oTree"
>
>
>this is created by the class browser but does not work. How do I tell the olecontrol is actually a treeview etc..
>
>
>Thanks
>
>
>Peter

Peter,
To add an activex in code use its dll.classname as OleClass property. ie: A treeview with ImageList in code (sorry this was a test code and there is more than needed code):
* 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 = 380
  Width = 628
  DoCreate = .T.
  Caption = "TreeView - testpad"
  BackColor = Rgb(192,192,192)
  Name = "myForm"
  ShowWindow=2

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

  Add Object cp As CommandButton With Caption='Copy to clipboard'

  Add Object myTree As OleControl With ;
    Top = 92, ;
    Left = 0, ;
    Height = 286, ;
    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'

  Procedure cp.Click
    Tvlister(Thisform.oletreeview)
  Endproc

  Procedure oleimageslist.Init
    lcIconPath = Home(4)+'Icons\Win95'
    With This
      .ImageHeight = 16
      .ImageWidth = 16
      .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"\openfold.ico"))
      .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"\clsdfold.ico"))
      .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"\525flop1.ico"))
      .ListImages.Add(,"Floppy",LoadPicture(lcIconPath+"\35floppy.ico"))
      .ListImages.Add(,"NetDrive",LoadPicture(lcIconPath+"\drivenet.ico"))
      .ListImages.Add(,"CDDrive",LoadPicture(lcIconPath+"\CDdrive.ico"))
    Endwith
  Endproc

  *-- 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
    With This.oletreeview
      .Object.CheckBoxes = .T.
      .linestyle =1
      .labeledit =1
      .indentation = 5
      .imagelist = This.oleimageslist.Object
      .PathSeparator = '\'
      .Scroll = .T.
      .OLEDragMode = 0
      .OLEDropMode = 0
    Endwith
    This.filltree("c:\")
  Endproc

  Procedure CheckRest
    Lparameters tnIndex, tlCheck
    Local lnIndex, lnLastIndex
    With This.oletreeview
      .nodes(tnIndex).Checked = tlCheck
      If .nodes(tnIndex).Children > 0
        lnIndex  = .nodes(tnIndex).Child.Index
        lnLastIndex = .nodes(tnIndex).Child.LastSibling.Index
        This.CheckRest(lnIndex, tlCheck)
        Do While lnIndex # lnLastIndex
          lnIndex = .nodes(lnIndex).Next.Index
          This.CheckRest(lnIndex, tlCheck)
        Enddo
      Endif
    Endwith
  Endproc

  Procedure oletreeview.Expand
    *** ActiveX Control Event ***
    Lparameters Node
    If Node.Key='L003'
      Node.expanded = .F.
      Return
    Endif
    Thisform._SubFolders(Node)
    Node.ensurevisible
  Endproc

  Procedure oletreeview.NodeClick
    *** ActiveX Control Event ***
    Lparameters Node
    Node.ensurevisible
    This.DropHighlight = .Null.
  Endproc

  Procedure oletreeview.KeyUp
    Lparameters nKeyCode,Shift
    *	Wait window Transform(nKeyCode)+'_'+Transform(shift) TIMEOUT 2
    If nKeyCode = 32 And Shift=0
      oNode=This.SelectedItem
      If Type("oNode")= "O" And !Isnull(oNode)
        If Type('oNode.parent')='O' And !Isnull(oNode.Parent)
          llChecked = oNode.Parent.Checked
          oNode.Checked = m.llChecked
        Else
          *oNode.Checked = !oNode.Checked
          Thisform.CheckRest(oNode.Index,oNode.Checked)
        Endif
      Endif
    Endif
  Endproc

  Procedure oletreeview.MouseUp
    Lparameters Button, Shift, x, Y
    If Button=1
      oNode = This.HitTest( x * Thisform.nxtwips, Y * Thisform.nytwips )
      If Type("oNode")= "O" And !Isnull(oNode)
        If Type('oNode.parent')='O' And !Isnull(oNode.Parent)
          llChecked = oNode.Parent.Checked
          oNode.Checked = m.llChecked
        Else
          Thisform.CheckRest(oNode.Index,oNode.Checked)
        Endif
      Endif
    Endif
  Endproc

  *!*	  Procedure oletreeview.NodeCHeck
  *!*	*** ActiveX Control Event ***
  *!*	Lparameters node
  *!*	LOCAL lnIndex, llChecked
  *!*	llChecked = node.Checked
  *!*	If Type('node.parent')='O' and !IsNull(node.parent)
  *!*	nodefault
  *!*	llChecked = node.parent.checked
  *!*	EndIf
  *!*	node.Checked = llChecked
  *!*	thisform.CheckRest(Node.Index,llChecked)
  *!*	return
  *!*	If node.Children > 0
  *!*		Node.Child.Checked = llChecked
  *!*		thisform.CheckRest(Node.Child.Index,llChecked)
  *!*		lnIndex  = Node.Child.Index
  *!*		Do while lnIndex # Node.Child.LastSibling.Index
  *!*			this.Nodes(lnIndex).Next.Checked = llChecked
  *!*			thisform.CheckRest(lnIndex,llChecked)
  *!*			lnIndex = this.Nodes(lnIndex).Next.Index
  *!*		Enddo
  *!*	Endif
  *!*	Endproc


  Procedure oletreeview.LostFocus
    With This.SelectedItem
      .BackColor = Rgb(49,106,197)
      .ForeColor = Rgb(255,255,255)
    Endwith
  Endproc

  Procedure oletreeview.GotFocus
    This.SelectedItem.BackColor = Rgb(255,255,255)
  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
      If !Isnull(oHitTest)
        If Y <= This.Top + 150 	And Type('oHitTest.Previous')='O'	 And !Isnull(oHitTest.Previous)
          oHitTest.Previous.ensurevisible
        Endif
        If Y >= This.Top + This.Height - 150 And Type('oHitTest.Next')='O' And !Isnull(oHitTest.Next)
          oHitTest.Next.ensurevisible
        Endif
      Endif
    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

  Procedure ProcessNodes
    Lparameters toNode
    Local loChildNode
    ? toNode.Text
    If toNode.Children > 0
      loChildNode = toNode.Child
      Do While Vartype( loChildNode ) = [O]
        Thisform.ProcessNodes( loChildNode )
        loChildNode = loChildNode.Next
      Enddo
    Endif
  Endproc

Enddefine
Also check UT magazine June 2001 issue.

PS: You can get what to use for OleClass, temporarily adding one to a form and checking OleClass there.
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