|
|
|
|
|
|
Die Kontrollmöglichkeiten über das Bearbeiten der Knotentexte in einem TreeView-Steuerelement durch den Anwender (LabelEdit) sind etwas mager ausgefallen. Zwar werden Sie über die Ereignisse BeginLabelEdit und AfterLabelEdit über Beginn und Ende der Bearbeitung informiert. Doch eine ausgefeiltere Validierung der Änderungen ist kaum möglich. Sie können lediglich die Änderungen verwerfen. Die bei einer TextBox gewohnten Tastatur- und Mausereignisse und das Change-Ereignis fehlen ebenso wie auch die entsprechenden Eigenschaften des Editierfeldes.
Nun könnte man versuchen, das Fenster-Handle des Editierfeldes zu ermitteln und somit per Subclassing und weitere API-Funktionen zum Ziel zu gelangen. Als ein weitaus mehr VB-Gewohnheiten entsprechender Weg erscheint mir jedoch der Ansatz, das Editfeld einfach durch eine eigene, ganz gewöhnliche Visual Basic-TextBox zu ersetzen. Somit kommen Sie auf einfache Weise in den Genuss der gewünschten Kontrolle und können auch einfacher Anpassungen an individuelle Anforderungen vornehmen. Bei einem TreeView der Version 6 können Sie sogar die Text- und Hintergrundfarbe und auch die Schriftstärke ("Bold") des Knotens in das Editfeld übernehmen.
Das im folgenden vorgestellte Konzept beruht auf einem UserControl (TvwEdit) mit einer TextBox, das Ressourcen sparend nur einmal auf einem Form vorhanden sein braucht und für jedes TreeView auf diesem Form verwendet werden kann. Dazu unterbinden Sie im BeforeEdit-Ereignis eines TreeViews den Beginn des internen Editier-Modus (Cancel = True) und rufen statt dessen die Methode BeginEdit von TvwEdit auf. Dabei übergeben Sie eine Referenz auf das betreffende TreeView. Optional können Sie angeben, ob die Eingabelänge begrenzt werden soll, und ob Text- bzw. Hintergrundfarbe und Schriftstärke vom Knoten übernommen werden sollen. Diese Optionen gelten nur für den jeweiligen Editier-Zyklus und überschreiben die ebenfalls vorhandenen Eigenschaften von TvwEdit (MaxLength, UseBoldFont, UseForeColor, UseBackColor). Die entsprechenden Werte des Knotens werden gegebenenfalls auf die TextBox übertragen. Ebenfalls wird das Font-Objekt des TreeViews dupliziert (siehe "Geklonte Fonts" khwclonefont.htm) und sowohl der TextBox als auch dem UserControl zugewiesen. Dann wird die TextBox per API-Funktion SetParent in das TreeView-Fenster verschoben. Die Positionierung beruht auf der Ermittlung des Knoten-Rechtecks (siehe "Rechteck eines Knotens" khwtvwnoderect.htm). Die TextBox wird nun sichtbar gemacht und erhält den Fokus. Schließlich wird noch ein Timer eingeschaltet, der ständig überwacht, ob die TextBox noch den Fokus inne hat. Verliert sie ihn, wird der Editier-Zyklus (Abfrage über die Eigenschaft InEdit) automatisch beendet.
Der Editier-Zyklus kann auch manuell über die Methoden CancelEdit und EndEdit oder über die Tastatur (Escape oder Return) abgebrochen bzw. beendet werden. Während des Editier-Zyklus stehen die üblichen TextBox-Eigenschaften wie Text, SelText, SelLength und SelStart zur Verfügung. Gleichfalls werden die gewohnten Ereignisse ausgelöst. Referenzen auf das TreeView und auf den gerade editierten Knoten erhalten Sie jederzeit während des Editier-Zyklus über die Eigenschaften EditTreeView und EditNode. Für den Fall, dass Sie die TextBox über API-Funktionen manipulieren möchten, erhalten Sie deren Fenster-Handle über die Eigenschaft EditHWnd.
Beim Beenden des Edit-Zyklus wird zunächst das Ereignis AfterEdit mit Übergabe des ursprünglichen Knotentextes und des aktuellen Editier-Ergebnisses ausgelöst. Als weiterer Parameter wird Cancel übergeben. Er enthält zunächst den Wert des Abbruchmodus (tdOK oder tdCancel) und kann beliebig geändert werden. Sie können auch die Werte tdReEdit und tdReEditUndo zurückgeben. Bei ersterem wird der Editier-Zyklus doch nicht beendet, bei zweiterem wird dazu noch der ursprüngliche Knotentext wieder hergestellt.
Falls Sie für die TextBox ein eigenes Kontextmenü vorsehen möchten - auch dafür ist gesorgt (siehe "Pop-It-Yourself" khwuserpopupmenu.htm). Wenn Sie die Eigenschaft DefaultContextMenu auf False setzen (Voreinstellung ist True), wird das Standard-Kontextmenü der TextBox unterdrückt und es wird nach dem MouseUp-Ereignis zusätzlich noch das ContextMenu-Ereignis mit den Parametern Shift, X und Y ausgelöst.
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetFocus Lib "user32" () As Long
ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
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 SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private mCancelled As teCancelModeConstants
Private mLockChangeEvent As Boolean
Private mLockResize As Boolean
Private mNode As Node
Private mOldParent As Long
Private mOldText As String
Private mTreeView As TreeView
Public Event AfterEdit(OldText As String, NewText As String, _
Cancel As teCancelModeConstants)
Public Event Change()
Public Event Click()
Public Event ContextMenu(Shift As Integer, X As Single, Y As Single)
Public Event DblClick()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Enum teCancelModeConstants
teOK
teCancel
teReEdit
teReEditUndo
End Enum
Public Enum teErrorConstants
teErrNotInEdit = vbObjectError + 30000
End Enum
Private pDefaultContextMenu As Boolean
Private pEnabled As Boolean
Private pInEdit As Boolean
Private pMaxLength As Long
Private pUseBackColor As Boolean
Private pUseBoldFont As Boolean
Private pUseForeColor As Boolean
Public Property Get DefaultContextMenu() As Boolean
DefaultContextMenu = pDefaultContextMenu
End Property
Public Property Let DefaultContextMenu _
(New_DefaultContextMenu As Boolean)
pDefaultContextMenu = New_DefaultContextMenu
PropertyChanged "DefaultContextMenu"
End Property
Public Property Get EditHWnd() As Long
If pInEdit Then
EditHWnd = txt.hWnd
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get EditNode() As Object
If pInEdit Then
Set EditNode = mNode
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get EditTreeView() As Object
If pInEdit Then
Set EditTreeView = mTreeView
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get Enabled() As Boolean
Enabled = pEnabled
End Property
Public Property Let Enabled(New_Enabled As Boolean)
pEnabled = New_Enabled
PropertyChanged "Enabled"
End Property
Public Property Get hWnd() As Long
If pInEdit Then
hWnd = UserControl.hWnd
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get InEdit() As Boolean
InEdit = pInEdit
End Property
Public Property Get MaxLength() As Long
MaxLength = pMaxLength
End Property
Public Property Let MaxLength(New_MaxLength As Long)
pMaxLength = New_MaxLength
PropertyChanged "MaxLength"
End Property
Public Property Get OldText() As String
If pInEdit Then
OldText = mOldText
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get Text() As String
If pInEdit Then
Text = txt.Text
ElseIf Ambient.UserMode Then
Err.Raise teErrNotInEdit
End If
End Property
Public Property Let Text(New_Text As String)
If pInEdit Then
txt.Text = New_Text
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get SelLength() As Long
If pInEdit Then
SelLength = txt.SelLength
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Let SelLength(New_SelLength As Long)
If pInEdit Then
txt.SelLength = New_SelLength
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get SelStart() As Long
If pInEdit Then
SelStart = txt.SelStart
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Let SelStart(New_SelStart As Long)
If pInEdit Then
txt.SelStart = New_SelStart
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get SelText() As String
If pInEdit Then
SelText = txt.SelText
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Let SelText(New_SelText As String)
If pInEdit Then
txt.SelText = New_SelText
Else
Err.Raise teErrNotInEdit
End If
End Property
Public Property Get UseBackColor() As Boolean
UseBackColor = pUseBackColor
End Property
Public Property Let UseBackColor(New_UseBackColor As Boolean)
pUseBackColor = New_UseBackColor
PropertyChanged "UseBackColor"
End Property
Public Property Get UseBoldFont() As Boolean
UseBoldFont = pUseBoldFont
End Property
Public Property Let UseBoldFont(New_UseBoldFont As Boolean)
pUseBoldFont = New_UseBoldFont
PropertyChanged "UseBoldFont"
End Property
Public Property Get UseForeColor() As Boolean
UseForeColor = pUseForeColor
End Property
Public Property Let UseForeColor(New_UseForeColor As Boolean)
pUseForeColor = New_UseForeColor
PropertyChanged "UseForeColor"
End Property
Public Sub BeginEdit(TreeView As Object, _
Optional ByVal MaxLength As Variant, _
Optional ByVal UseBoldFont As Variant, _
Optional ByVal UseForeColor As Variant, _
Optional ByVal UseBackColor As Variant)
Dim nLeft As Single
Dim nTop As Single
Dim nRight As Single
Dim nBottom As Single
If pInEdit Then
zHide
End If
mCancelled = teOK
If pEnabled Then
Set mTreeView = TreeView
Set mNode = mTreeView.SelectedItem
If Not (mNode Is Nothing) Then
mOldText = mNode.Text
mNode.EnsureVisible
If zGetTvwNodeRect(mTreeView, nLeft, nTop, nRight, _
nBottom) Then
With txt
Set .Font = zCloneFont(mTreeView.Font)
Set UserControl.Font = .Font
If IsMissing(UseBoldFont) Then
UseBoldFont = pUseBoldFont
End If
If UseBoldFont And mNode.Bold Then
.Font.Bold = True
End If
If IsMissing(UseForeColor) Then
UseForeColor = pUseForeColor
End If
If UseForeColor Then
.ForeColor = mNode.ForeColor
Else
.ForeColor = vbWindowText
End If
If IsMissing(UseBackColor) Then
UseBackColor = pUseBackColor
End If
If UseBackColor Then
.BackColor = mNode.BackColor
UserControl.BackColor = mNode.BackColor
Else
.BackColor = vbWindowBackground
UserControl.BackColor = vbWindowBackground
End If
If IsMissing(MaxLength) Then
.MaxLength = pMaxLength
Else
.MaxLength = MaxLength
End If
mOldParent = SetParent(UserControl.hWnd, mTreeView.hWnd)
mLockResize = True
Extender.Move nLeft, nTop, nRight - nLeft, nBottom - nTop
mLockResize = False
mNode.Text = ""
mLockChangeEvent = True
.Text = mOldText
mLockChangeEvent = False
zSetWidth
.SelStart = 0
.SelLength = Len(.Text)
Extender.Visible = True
Extender.ZOrder 0
.SetFocus
End With
tmrFocus.Enabled = True
pInEdit = True
End If
End If
End If
End Sub
Public Sub CancelEdit()
If pInEdit Then
mCancelled = teCancel
zHide
Else
Err.Raise teErrNotInEdit
End If
End Sub
Public Sub EndEdit(Optional ByVal ForceCancel _
As teCancelModeConstants = teOK)
If pInEdit Then
mCancelled = ForceCancel
zHide
Else
Err.Raise teErrNotInEdit
End If
End Sub
Public Sub SelAll()
If pInEdit Then
With txt
.SelStart = 0
.SelLength = Len(.Text)
End With
Else
Err.Raise teErrNotInEdit
End If
End Sub
Private Sub tmrFocus_Timer()
If GetFocus() <> txt.hWnd Then
zHide
End If
End Sub
Private Sub txt_Change()
If pInEdit Then
If Not mLockChangeEvent Then
zSetWidth
RaiseEvent Change
End If
End If
End Sub
Private Sub txt_Click()
If pInEdit Then
RaiseEvent Click
End If
End Sub
Private Sub txt_DblClick()
If pInEdit Then
RaiseEvent DblClick
End If
End Sub
Private Sub txt_KeyDown(KeyCode As Integer, Shift As Integer)
If pInEdit Then
RaiseEvent KeyDown(KeyCode, Shift)
Select Case KeyCode
Case vbKeyEscape
mCancelled = teCancel
zHide
KeyCode = 0
Case vbKeyReturn
zHide
KeyCode = 0
End Select
End If
End Sub
Private Sub txt_KeyPress(KeyAscii As Integer)
If pInEdit Then
RaiseEvent KeyPress(KeyAscii)
End If
End Sub
Private Sub txt_KeyUp(KeyCode As Integer, Shift As Integer)
If pInEdit Then
RaiseEvent KeyUp(KeyCode, Shift)
End If
End Sub
Private Sub txt_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Const WM_RBUTTONDOWN = &H204
If pInEdit Then
If pDefaultContextMenu Then
RaiseEvent _
MouseDown(Button, Shift, txt.Left + X, txt.Left + Y)
Else
If Button = vbRightButton Then
SendMessage UserControl.hWnd, WM_RBUTTONDOWN, 0&, 0&
Exit Sub
Else
RaiseEvent _
MouseDown(Button, Shift, txt.Left + X, txt.Left + Y)
End If
End If
End If
End Sub
Private Sub txt_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If pInEdit Then
RaiseEvent _
MouseMove(Button, Shift, txt.Left + X, txt.Left + Y)
End If
End Sub
Private Sub txt_MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If pInEdit Then
RaiseEvent _
MouseUp(Button, Shift, txt.Left + X, txt.Left + Y)
End If
End Sub
Private Sub UserControl_AmbientChanged(PropertyName As String)
Select Case LCase$(PropertyName)
Case "displayname"
zSetDisplayName
End Select
End Sub
Private Sub UserControl_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
RaiseEvent _
MouseUp(Button, Shift, txt.Left + X, txt.Left + Y)
If Not pDefaultContextMenu Then
If Button = vbRightButton Then
RaiseEvent ContextMenu(Shift, X, Y)
End If
End If
End Sub
Private Sub UserControl_Resize()
zResize False
End Sub
Private Sub UserControl_Initialize()
pDefaultContextMenu = True
pEnabled = True
pUseBoldFont = True
End Sub
Private Sub UserControl_InitProperties()
zSetDisplayName
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
zSetDisplayName
pDefaultContextMenu = _
PropBag.ReadProperty("DefaultContextMenu", True)
pEnabled = PropBag.ReadProperty("Enabled", True)
pMaxLength = PropBag.ReadProperty("MaxLength", 0)
pUseBackColor = PropBag.ReadProperty("UseBackColor", False)
pUseBoldFont = PropBag.ReadProperty("UseBoldFont", True)
pUseForeColor = PropBag.ReadProperty("UseForeColor", False)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "DefaultContextMenu", _
pDefaultContextMenu, True
PropBag.WriteProperty "Enabled", pEnabled, True
PropBag.WriteProperty "MaxLength", pMaxLength, 0
PropBag.WriteProperty "UseBackColor", pUseBackColor, False
PropBag.WriteProperty "UseBoldFont", pUseBoldFont, True
PropBag.WriteProperty "UseForeColor", pUseForeColor, False
End Sub
Private Function zCloneFont(Font As IFont) As StdFont
Font.Clone zCloneFont
End Function
Private Function zGetTvwNodeRect(tvw As TreeView, _
RetLeft As Single, RetTop As Single, RetRight As Single, _
RetBottom As Single) As Boolean
Dim nRect As RECT
Const TV_FIRST = &H1100
Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Const TVM_GETITEMRECT = (TV_FIRST + 4)
Const TVGN_CARET = &H9
With tvw
nRect.Left = _
SendMessage(.hWnd, TVM_GETNEXTITEM, ByVal TVGN_CARET, 0)
If nRect.Left Then
SendMessage .hWnd, TVM_GETITEMRECT, 1, nRect
zGetTvwNodeRect = True
With nRect
RetLeft = .Left * Screen.TwipsPerPixelX
RetTop = .Top * Screen.TwipsPerPixelY
RetRight = .Right * Screen.TwipsPerPixelX
RetBottom = .Bottom * Screen.TwipsPerPixelY
End With
End If
End With
End Function
Private Sub zHide()
Dim nNewText As String
nNewText = txt.Text
RaiseEvent AfterEdit(mOldText, nNewText, mCancelled)
Select Case mCancelled
Case teOK
mNode.Text = nNewText
Case teCancel
mNode.Text = mOldText
Case teReEdit
mCancelled = teOK
txt.SetFocus
Exit Sub
Case teReEditUndo
mCancelled = teOK
mLockChangeEvent = True
With txt
.Text = mOldText
.SetFocus
zSetWidth
.SelStart = Len(mOldText)
.SelStart = 0
.SelLength = Len(mOldText)
End With
mLockChangeEvent = False
Exit Sub
End Select
tmrFocus.Enabled = False
Extender.Visible = False
SetParent UserControl.hWnd, mOldParent
Set mNode = Nothing
Set mTreeView = Nothing
mOldParent = 0
pInEdit = False
End Sub
Private Sub zResize(ByVal Visible As Boolean)
Dim nDiffX As Single
Dim nDiffY As Single
Static sInProc As Boolean
If Not mLockResize Then
If sInProc Then
Exit Sub
Else
sInProc = True
End If
On Error Resume Next
Extender.Visible = Visible
With UserControl
nDiffX = .Width - ScaleWidth
nDiffY = .Height - .ScaleHeight
With txt
.Height = 1
If Ambient.UserMode Then
UserControl.Height = _
.Height + nDiffY + 2 * Screen.TwipsPerPixelY
Else
UserControl.Size UserControl.TextWidth(.Text & " "), _
.Height + nDiffY + 2 * Screen.TwipsPerPixelY
End If
.Move 0, Screen.TwipsPerPixelY, _
UserControl.ScaleWidth + nDiffX
End With
End With
sInProc = False
End If
End Sub
Private Function zSetDisplayName()
With Ambient
If Not .UserMode Then
txt.Text = " " & .DisplayName
UserControl_Resize
End If
End With
End Function
Private Sub zSetWidth()
Dim nRect As RECT
Dim nRight As Long
Dim nLeft As Long
nLeft = Extender.Left \ Screen.TwipsPerPixelX
GetClientRect mTreeView.hWnd, nRect
With UserControl
nRight = nLeft + .ScaleX(.TextWidth(txt.Text & " "), _
vbTwips, vbPixels)
If nRight > nRect.Right Then
nRight = nRect.Right
End If
mLockResize = True
.Width = (nRight - nLeft) * Screen.TwipsPerPixelX
mLockResize = False
End With
zResize True
End Sub
|
|
|