会员登录 - 用户注册 - 网站地图 Office中国(office-cn.net),专业Office论坛
当前位置:主页 > 技巧 > Access技巧 > ActiveX控件图表 > 正文

ACCESS EXCEL 一个增强Treeview 节点编辑能力的类模块

时间:2013-10-01 20:45 来源:未知 作者:admin 阅读:

CTreeViewEdit - ACCESS EXCEL 一个增强Treeview 节点编辑能力的类模块

'-------------------------------------------------------
' The CTREEVIEWEDIT Class module
'
' This class lets you use a regular TextBox control to
' edit a treeview node's label. All you have to do to
' use this class is adding a TextBox control to the same
' form that hosts the TreeView control, and initialize
' an instance of the class from inside the form's Load
' event. In the following example we have a treeview
' control named tvwHierarchy and a support textbox control
' named txtSupport

'  Dim TVEdit As New CTreeViewEdit
'
'  Private Sub Form_Load()
'      TVEdit.Init tvwHierarchy, txtSupport
'  End Sub

' You can then write code in the event procs of txtSupport,
' as you would do with a regular textbox. For example you
' can filter out invalid keys. You can also terminate the
' edit mode by invoking the class's EndLabelEdit method
' (pass True to accept the new value, False to reject it)

'Private Sub txtSupport_KeyPress(KeyAscii As Integer)
'    If KeyAscii >= 48 And KeyAscii <= 57 Then
'        ' filter out numeric keys
'        KeyAscii = 0
'    ElseIf KeyAscii = 8 Then
'        ' the backspace cancels the operation
'        TVEdit.EndLabelEdit False
'    End If
'End Sub
'-------------------------------------------------------

'-------------------------------------------------------
' API Declares
'-------------------------------------------------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
    hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _
    lpRect As RECT) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const TV_FIRST = &H1100
Private Const TVM_GETITEMRECT = (TV_FIRST + 4)
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVGN_CARET = 9

'-------------------------------------------------------
' module variables
'-------------------------------------------------------

' the TreeView control
Dim WithEvents TreeView As TreeView
' the hidden textbox control
Dim WithEvents TextBox As TextBox
' the parent form (can be anything)
Dim Parent As Object

' these variables are active when the user is editing the node label
' the previous value of the Node's Text property
Dim saveText As String
' the control that had Default = True
Dim defaultCtrl As Object
' the control that had Cancel = True
Dim cancelCtrl As Object

' Initialize this instance

Sub Init(TView As TreeView, TBox As TextBox)
    Set TreeView = TView
    Set TextBox = TBox
    Set Parent = TextBox.Parent
    TextBox.Visible = False
End Sub

'-------------------------------------------------------
' event procedures
'-------------------------------------------------------

' when the user clicks on a treeview's item
' this procedure gets the control and cancels
' the default operation

Private Sub TreeView_BeforeLabelEdit(Cancel As Integer)
    Cancel = True
    StartLabelEdit
End Sub

' when the user types in the textbox, grow or shrink it

Private Sub TextBox_Change()
    Dim saveFont As StdFont
    Dim wi As Single
    Dim borderWidth As Single
    
    ' temporarily change the parent form's font,
    ' to use its TextWidth method
    Set saveFont = Parent.Font
    Set Parent.Font = TextBox.Font
    wi = Parent.TextWidth(TextBox.Text) + Parent.ScaleX(20, vbPixels, _
        Parent.ScaleMode)
    Set Parent.Font = saveFont
    ' this is the Treeview's border, in the same coordinate
    ' system as the parent form
    borderWidth = Parent.ScaleX(2, vbPixels, Parent.ScaleMode)
    
    ' don't let the textbox grow larger than the treeview
    If TextBox.Left + wi > TreeView.Left + TreeView.Width - borderWidth Then
        wi = TreeView.Left + TreeView.Width - TextBox.Left - borderWidth
    End If
    
    TextBox.Width = wi
    
End Sub

' terminate the edit mode when the user types
' Enter or Escape keys

Private Sub TextBox_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            EndLabelEdit True
            KeyAscii = 0
        Case 27
            EndLabelEdit False
            KeyAscii = 0
    End Select
End Sub

' terminate the edit mode when the user clicks
' outside of the textbox control

Private Sub TextBox_MouseDown(Button As Integer, Shift As Integer, X As Single, _
    Y As Single)
    If X < 0 Or Y < 0 Or X > TextBox.Width Or Y > TextBox.Height Then
        EndLabelEdit True
    End If
End Sub

'-------------------------------------------------------
' Support routines
'-------------------------------------------------------

' enter edit mode

Private Sub StartLabelEdit()
    ' get the edit rectangle for the selected item
    Dim lpRect As RECT, lpClientRect As RECT
    Dim hNode As Long
    
    ' get the handle of the selected node
    hNode = SendMessage(TreeView.hWnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
    ' get the bounding rectangle for this node
    ' the function expects in input the handle of the item
    ' at the beginning of the RECT structure
    lpRect.Left = hNode
    If SendMessage(TreeView.hWnd, TVM_GETITEMRECT, True, lpRect) = 0 Then
        ' a zero value means error
        Exit Sub
    End If

    ' convert coordinates into form coordinates
    With lpRect
        .Left = TreeView.Left + Parent.ScaleX(.Left, vbPixels, Parent.ScaleMode)
        .Top = TreeView.Top + Parent.ScaleY(.Top, vbPixels, Parent.ScaleMode)
        .Right = TreeView.Left + Parent.ScaleX(.Right, vbPixels, _
            Parent.ScaleMode)
        .Bottom = TreeView.Top + Parent.ScaleY(.Bottom, vbPixels, _
            Parent.ScaleMode)
    End With
    
    ' move the textbox in front of the TreeView
    With TextBox
        ' move the textbox in the right position
        .Move lpRect.Left, lpRect.Top, lpRect.Right - lpRect.Left + 200, _
            lpRect.Bottom - lpRect.Top
        .ZOrder
        
        ' transfer the node's text to the TextBox control
        .Text = TreeView.SelectedItem.Text
        .SelStart = 0
        .SelLength = Len(.Text)
        Set .Font = TreeView.Font
        
        ' make the textbox visible and give it the focus
        .Visible = True
        .SetFocus
        
        ' grab the mouse capture
        SetCapture .hWnd
        
        ' disable any button with Default or Cancel property
        ' this is necessary because we want to trap the Enter
        ' and Cancel keys while the user is editing the
        ' node's label.
        Set defaultCtrl = Nothing
        Set cancelCtrl = Nothing
        Dim ctrl As Control
        
        On Error Resume Next
        
        For Each ctrl In Parent.Controls
            If ctrl.Default = False Then
                ' not supported or Default = False
            Else
                Set defaultCtrl = ctrl
                ctrl.Default = False
            End If
            If ctrl.Cancel = False Then
                ' not supported or Cancel = False
            Else
                Set cancelCtrl = ctrl
                ctrl.Cancel = False
            End If
        Next
    
        ' save node's text, then clear it - this is necessary to avoid the 
        ' original
        ' text appears if the editing textbox shrinks
        saveText = TreeView.SelectedItem.Text
        TreeView.SelectedItem.Text = ""
    
    End With

End Sub

' this procedure is called from TextBox event procs
' or by the client application

Sub EndLabelEdit(AcceptIt As Boolean)
    If AcceptIt Then
        ' if not canceled, assign the text to the underlying node
        TreeView.SelectedItem.Text = TextBox.Text
    Else
        ' else restore original text
        TreeView.SelectedItem.Text = saveText
    End If
    ' release mouse capture, and restore form's font
    ReleaseCapture
    
    ' make the TextBox invisible and clear it
    TextBox.Visible = False
    TextBox.Text = ""
    TreeView.SetFocus
    
    ' restore Default and Cancel buttons, if any
    On Error Resume Next
    defaultCtrl.Default = True
    cancelCtrl.Cancel = True
End Sub
 

(责任编辑:admin)

顶一下
(1)
100%
踩一下
(0)
0%
发表评论
请自觉遵守互联网相关的政策法规,严禁发布色情、暴力、反动的言论。
评价: