Question

我在 Google 上找不到任何合适的解决方案，我想知道是否有可能的解决方案符合我的意图。

我想要 2 个 TreeView 控件相互交互。用户应该能够从左侧拖动一个元素并将其放到右侧的 TreeView 控件中。左侧已移动的元素应该远离左侧的 TreeView 控件，并且应该在右侧的 TreeView 上可见。它是否会成为用户突出显示的元素的子元素或成为兄弟元素并不重要，因为要回答的第一个问题是它是否可能。

到目前为止我拥有的是 module1：

Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Public Function PixelsPerInch(Par As Integer) As Double
    Dim hDC As Long
    Dim lDotsPerInch As Long

    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, Par)
    PixelsPerInch = lDotsPerInch
    ReleaseDC 0, hDC
End Function

Public Sub createPopUp()
    Dim oComBar As CommandBar

    On Error Resume Next
    Application.CommandBars("PopUp").Delete
    Set oComBar = CommandBars.Add(Name:="PopUp", Position:=msoBarPopup, Temporary:=True)
    createMenueButton "Neues Unterelement einfügen", 462
    createMenueButton "Element kopieren", 19
    createMenueButton "Element ausschneiden", 21
    createMenueButton "Element einfügen", 22
    createMenueButton "Element löschen (mit Unterelementen)", 464
    createMenueButton "Element löschen (ohne Unterelemente)", 464
End Sub

Private Sub createMenueButton(strButText As String, iFaceId As Integer)
    Dim oBut As CommandBarButton
    Set oBut = Application.CommandBars("PopUp").Controls.Add()
    oBut.FaceId = iFaceId
    oBut.Caption = strButText
    Set oBut = Nothing
End Sub

...以及表单中的代码：

'    Necessary libraries to be activated:
''    - Microsoft Forms x.0 Objekt Library
''    - Microsoft Windows Common Controls x.0 (SPx)

'    Für ausgewählten Node (Drag and Drop)
Private oSelectedNode As MSComctlLib.Node

Private Sub TreeView1_LostFocus()
    ' Verlassen des TreeViews -> Kein Highlighting
    Set TreeView1.DropHighlight = Nothing
End Sub

Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    ' Hier wird vor dem Drag and Drop sichergestellt, dass der Selected Item auch der aktuell ausgewählte Node ist
    ' MouseDown wird vor dem Drag and Drop Event ausgeführt

    ' TreeView1.HitTest verlangt in VBA (vermutl. abweichend zu VB) die x und y Koordinate in TWIPS (Twentieth of an Inch Point) also 1 / 1400 Zoll
    ' http://de.wikipedia.org/wiki/Twip
    Dim XFactor As Double, YFactor As Double
    ' Ermittlung der PPI (PixelPerInch) auf dem Client Rechner
    ' Entspricht im Normalfall den DPI Einstellungen: Desktop -> rechte Maustaste -> Eigenschaften -> Allgemein
    ' 90 = Vertikal  88 = Horizontal
    XFactor = PixelsPerInch(88)
    YFactor = PixelsPerInch(90)
    Set oSelectedNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
    Set TreeView1.DropHighlight = oSelectedNode
    Set TreeView1.SelectedItem = oSelectedNode
End Sub

Private Sub TreeView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    ' Popup Menü im TreeView bei klick auf Rechte Maustaste
    Dim oNode As MSComctlLib.Node
    Dim XFactor As Double, YFactor As Double

    If Button <> vbKeyRButton Then Exit Sub
    '    Procedere wie beschrieben
    XFactor = PixelsPerInch(88)
    YFactor = PixelsPerInch(90)
    Set oNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
    '    Kein Node -> kein Popup
    If oNode Is Nothing Then Exit Sub
    '    Popup abhängig von dem gewählten Node:
    CommandBars("PopUp").Controls("Element ausschneiden").Enabled = Not oNode.Parent Is Nothing
    CommandBars("PopUp").Controls("Element löschen (mit Unterelementen)").Enabled = Not oNode.Parent Is Nothing
    CommandBars("PopUp").Controls("Element löschen (ohne Unterelemente)").Enabled = Not oNode.Parent Is Nothing
    CommandBars("PopUp").ShowPopup
End Sub

Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    '    Hier wird das Drag and Drop durchgeführt
    Dim oNodeNewPosition As MSComctlLib.Node
    Dim XFactor As Double, YFactor As Double

    '    Verschieben des Root-Elements soll nicht möglich sein
    If oSelectedNode.Parent Is Nothing Then Exit Sub
    '    Procedere wie beschrieben
    XFactor = PixelsPerInch(88)
    YFactor = PixelsPerInch(90)
    Set oNodeNewPosition = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
    '    Cycle verhindern (Drag and Drop auf gleiche Position)
    If oSelectedNode = oNodeNewPosition Then Exit Sub
    If Not oNodeNewPosition Is Nothing Then
        Set oSelectedNode.Parent = oNodeNewPosition
    End If
End Sub

Private Sub TreeView1_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    '    Higlighting für das Element über das der "Drag" gerade ist
    Dim oNode As MSComctlLib.Node
    Dim XFactor As Double, YFactor As Double

    '    Procedere wie beschrieben
    XFactor = PixelsPerInch(88)
    YFactor = PixelsPerInch(90)
    Set oNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
    If oNode Is Nothing Then Exit Sub
    Set TreeView1.DropHighlight = oNode
End Sub

Public Sub fillTreeView()
    '    TreeView mit Testdaten füllen

    Dim oNode As MSComctlLib.Node
    TreeView1.LineStyle = tvwRootLines
    TreeView1.Nodes.Clear
    Set oNode = TreeView1.Nodes.Add(, , , "AP0: RootElement")
    Set oNode = TreeView1.Nodes.Add(1, tvwChild, , "AP1: Entwicklung")
    Set oNode = TreeView1.Nodes.Add(1, tvwChild, , "AP2: Test")
    Set oNode = TreeView1.Nodes.Add(3, tvwChild, , "AP21: Test Struktur")
    Set oNode = TreeView1.Nodes.Add(2, tvwChild, , "AP12: Entwicklung Software")
    Set oNode = TreeView1.Nodes.Add(3, tvwChild, , "AP22: Test Verhalten")
    For Each oNode In TreeView1.Nodes
        oNode.EnsureVisible
    Next
    TreeView1.OLEDragMode = ccOLEDragAutomatic
    TreeView1.OLEDropMode = ccOLEDropManual
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()


    Dim i       As Long
    Dim ii      As Long
    Dim iii     As Long

    ' TreeView mit ein paar Parent- und Child-
    ' Elementen füllen
    With Me.TreeView1
        For i = 1 To 5
            ' Hauptknoten (Parent-Nodes)
            .Nodes.Add , tvwFirst, "MainNode_" & i, _
                "MainNode_" & i

            For ii = 1 To 10
                ' Unterkonten (Child-Nodes)
                Me.TreeView1.Nodes.Add "MainNode_" & i, _
                    tvwChild, "Child_" & i & "_" & ii, _
                    "Child_" & i & "_" & ii

                ' Und Unter-Unterknoten
                For iii = 1 To 5
                    Me.TreeView1.Nodes.Add "Child_" & i & "_" & ii, _
                        tvwChild, "Child_" & i & "_" & ii & "_" & iii, _
                        "Child_" & i & "_" & ii & "_" & iii
                Next iii
            Next ii
        Next i

        .OLEDragMode = ccOLEDragAutomatic
        .OLEDropMode = ccOLEDropManual
    End With

 With Me.TreeView2
    For i = 1 To 5
        ' Hauptknoten (Parent-Nodes)
        .Nodes.Add , tvwFirst, "MainNode_" & i, _
            "MainNode_" & i

        For ii = 1 To 10
            ' Unterkonten (Child-Nodes)
            Me.TreeView2.Nodes.Add "MainNode_" & i, _
                tvwChild, "Child_" & i & "_" & ii, _
                "Child_" & i & "_" & ii

            ' Und Unter-Unterknoten
            For iii = 1 To 5
                Me.TreeView2.Nodes.Add "Child_" & i & "_" & ii, _
                    tvwChild, "Child_" & i & "_" & ii & "_" & iii, _
                    "Child_" & i & "_" & ii & "_" & iii
            Next iii
        Next ii
    Next i

    .OLEDragMode = ccOLEDragAutomatic
    .OLEDropMode = ccOLEDropManual
End With


End Sub

感谢来自 http://www.office-loesung.de/ftopic280909_0_0_asc.php 的 AndiGast （德国网站）

从一个 TreeView 控件拖放到另一个

0 个答案: