ActiveX/第三方控件/插件
ACCESS EXCEL 一个增强Treeview 节点编辑能力的类模块
2013-10-01 20:46:26

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