Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Explore no form
Message
De
03/03/2006 18:56:19
Peter Wagner
Point Informática Ltda.
Limeira, Brésil
 
 
À
03/03/2006 17:59:39
Peter Wagner
Point Informática Ltda.
Limeira, Brésil
Information générale
Forum:
Visual FoxPro
Catégorie:
COM/DCOM et OLE Automation
Titre:
Divers
Thread ID:
01101380
Message ID:
01101439
Vues:
15
Antonio,
segue um exemplo de treeview para exibir dos diretorios... em VFP8.0
* 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
  Height = 300
  Width = 600
  DoCreate = .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 = 290, ;
    Width = 590, ;
    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(4)+'Icons\'
  With this.oleimageslist
    .ImageHeight = 16
    .ImageWidth = 16
    .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"Win95\openfold.ico"))
    .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"Win95\clsdfold.ico"))
    .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"Win95\drivenet.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
Sobre esta base vc pode adicionar outros icones e fazer com que exiba os arquivos como o Windows Explorer...

[ ]´s
Peter


>Antonio,
>abrir o Windows explorer de dentro de um form do VFP não é possivel (pelo que eu saiba), mas vc pode abrir um webbrowser dentro de um form do VFP...
>Veja exemplo que vem com o VFP em Solution -> Foundation Classes -> Create a Visual Foxpro Web browser
>
>Para vc exibir o conteudo do HD e poder navegar vc tem que passar "c:\ " como o caminho inicial.
>A configuração de como vc exibe as pastas acredito vc configura no Explorer...
>Infelizmente esta opção não tem a "arvore" como no treeview no lado esquerdo.
>
>Outra opção seria usar a ActiveX "Outline Control" para exibir uma arvore..(somente a arvore)
>veja no solution o exemplo: ActiveX Controls -> Provide a Hierarchical display of items
>
>A forma mais completa é usar a TreeView, mas dependendo do numero de pastas e arquivos fica extrememente lento e se não me falha a memória tem um limite de 32.000 registros ou coisa parecida.
>Se usar a treeview vc tera de definir o icone de cada opjeto, tem uns exemplos para download na UT.
>
>[ ]´s
>Peter
>
>
>>Para acesassar o explorer sempre utilizei GETFILE(), GETDIR ou GETPICT. Só que estas funções abrem uma janela com o explore. Gostaria de saber se tem como abrir o Explorer dentro do meu form como se fosse um OleControl e coisa semelhante.
>>
>>Antônio Carlos
>>WS Desenvolvimento de Sistemas
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform