ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 19.09.2001

Diese Seite wurde zuletzt aktualisiert am 19.09.2001
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

LabelEdit unter Kontrolle

Zurück...

(-hg) mailto:hg_tvwedit@aboutvb.de

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

Beispiel-Projekt und UserControl TvwEdit (tvwedit.zip - ca. 13,2 KB)



Komponenten-Übersicht

Schnellsuche




Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer