Subitem Edit

[Kriechi]

Hallo!
erstmal, toll gemacht das ExplorerListview

Nur gibt es ne möglichkeit die items & subitems zu bearbeiten, so mit doppelklick und dann kann ich den text dirket ändern, kenn ich vom Windows Media Player zum beispiel. Comboboxen zur auswahlmöglichkeit wären auch schön
das ganze gibt es für die Listview vom Common Control 6.0 aber das kann ja nur die hälfte (wenn überhaubt) von deinem control!

kennst da jemand was nützliches?

mfg
Kriechi
[hr]
Translation for visitors not speaking German:
Hello!
at first, the ExplorerListView is well done

But is there any chance to edit the items and subitems, e. g. with a double click, so that I can directly change the text. Windows Media Player does this for example. ComboBoxes would be nice, too.
Code, that does what I want, exists for the listview of the Common Controls 6.0, but this listview has at most half of the features of yours!

Does anyone know how to do this?

Kind regards
Kriechi

[TiKu]

Hallo,

erstmal sei die Eigenschaft AllowLabelEditing genannt. Setzt man sie auf True, kann man die Items wie beschrieben umbenennen.
Für die SubItems sollte untenstehender Code helfen. FullRowSelect muss dabei auf True stehen; Text1 ist eine simple TextBox. Mit einer ComboBox geht das prinzipiell genauso.
[hr]
Translation for visitors not speaking German:
Hello,

at first let me mention the AllowLabelEditing property. If set to True, items can be renamed just as described.
For the sub-items the code below should help. FullRowSelect must be set to True; Text1 is a common TextBox. For a ComboBox the code would be more or less the same.

Code: Select all

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


  Private subItemToEdit As ListViewSubItem
  Private oldCaretItem As Long


  Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextW" (ByVal hDC As Long, ByVal lpStr As Long, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
  Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
  Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
  Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  Private Declare Function SendMessageAsLong Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Private Sub ListView1_AfterScroll(ByVal dx As Long, ByVal dy As Long)
  If Text1.Visible Then
    ' abort
    Text1.Visible = False
    Set subItemToEdit = Nothing
    ListView1.Refresh
  End If
End Sub

Private Sub ListView1_Click(ByVal listItem As ExLVwLibUCtl.IListViewItem, ByVal listSubItem As ExLVwLibUCtl.IListViewSubItem, ByVal button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal hitTestDetails As ExLVwLibUCtl.HitTestConstants)
  If Not (listItem Is Nothing) Then
    If listItem.Caret And (oldCaretItem = listItem.Index) Then
      ' the caret item was clicked (and it already was the caret before)
      If Not (listSubItem Is Nothing) Then
        ' enter sub-item edit mode
        Set subItemToEdit = listSubItem
      End If
    End If
  End If
End Sub

Private Sub ListView1_CustomDraw(ByVal listItem As ExLVwLibUCtl.IListViewItem, ByVal listSubItem As ExLVwLibUCtl.IListViewSubItem, textColor As stdole.OLE_COLOR, TextBackColor As stdole.OLE_COLOR, ByVal drawStage As ExLVwLibUCtl.CustomDrawStageConstants, ByVal itemState As ExLVwLibUCtl.CustomDrawItemStateConstants, ByVal hDC As Long, drawingRectangle As ExLVwLibUCtl.RECTANGLE, furtherProcessing As ExLVwLibUCtl.CustomDrawReturnValuesConstants)
  If Not (subItemToEdit Is Nothing) Then
    Select Case drawStage
      Case CustomDrawStageConstants.cdsPrePaint
        furtherProcessing = CustomDrawReturnValuesConstants.cdrvNotifyItemDraw
      Case CustomDrawStageConstants.cdsItemPrePaint
        If listItem.Index = subItemToEdit.ParentItem.Index Then
          furtherProcessing = CustomDrawReturnValuesConstants.cdrvNotifySubItemDraw
        End If
      Case CustomDrawStageConstants.cdsSubItemPrePaint
        If listSubItem.Index = subItemToEdit.Index Then
          furtherProcessing = CustomDrawReturnValuesConstants.cdrvSkipDefault
        End If
    End Select
  End If
End Sub

Private Sub ListView1_MouseDown(ByVal listItem As ExLVwLibUCtl.IListViewItem, ByVal listSubItem As ExLVwLibUCtl.IListViewSubItem, ByVal button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal hitTestDetails As ExLVwLibUCtl.HitTestConstants)
  If Not (ListView1.CaretItem Is Nothing) Then
    oldCaretItem = ListView1.CaretItem.Index
  Else
    oldCaretItem = -1
  End If
End Sub

Private Sub ListView1_StartingLabelEditing(ByVal listItem As ExLVwLibUCtl.IListViewItem, cancelEditing As Boolean)
  Const SM_CXEDGE = 45
  Const SM_CYEDGE = 46
  Const WM_GETFONT = &H31
  Const WM_SETFONT = &H30
  Dim hFont As Long
  Dim cx As Long
  Dim cy As Long
  Dim x As Long
  Dim y As Long

  If Not (subItemToEdit Is Nothing) Then
    cancelEditing = True

    x = 3 * GetSystemMetrics(SM_CXEDGE) + subItemToEdit.Left(ItemRectangleTypeConstants.irtLabelOnly)
    y = subItemToEdit.Top(ItemRectangleTypeConstants.irtLabelOnly)
    cy = subItemToEdit.Height(ItemRectangleTypeConstants.irtLabelOnly) + 2 * GetSystemMetrics(SM_CYEDGE)
    Text1.Move ListView1.Left + x, ListView1.Top + y, Text1.Width, cy

    Text1.Text = subItemToEdit.Text
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)

    ' ensure, that Text1 and ListView1 use the same font
    hFont = SendMessageAsLong(ListView1.hWnd, WM_GETFONT, 0, 0)
    SendMessageAsLong Text1.hWnd, WM_SETFONT, hFont, 0

    Text1.Visible = True
    Text1.SetFocus
  End If
End Sub

Private Sub Text1_Change()
  Const DT_CALCRECT = &H400
  Const DT_CENTER = &H1
  Const DT_EDITCONTROL = &H2000
  Const DT_NOPREFIX = &H800
  Const DT_SINGLELINE = &H20
  Dim cx As Long
  Dim hDC As Long
  Dim rc As RECT
  Dim str As String

  hDC = GetDC(ListView1.hWnd)
  str = Text1.Text
  DrawText hDC, StrPtr(str), Len(str), rc, DT_CALCRECT Or DT_CENTER Or DT_EDITCONTROL Or DT_NOPREFIX Or DT_SINGLELINE
  ReleaseDC ListView1.hWnd, hDC

  cx = rc.Right - rc.Left
  If cx < 50 Then
    cx = 50
  End If
  If Text1.Left - ListView1.Left + cx > ListView1.Width Then
    cx = ListView1.Width - Text1.Left + ListView1.Left
  End If

  Text1.Width = cx
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = KeyCodeConstants.vbKeyEscape Then
    ' abort
    Text1.Visible = False
    Set subItemToEdit = Nothing
  ElseIf KeyCode = KeyCodeConstants.vbKeyReturn Then
    ' apply text
    subItemToEdit.Text = Text1.Text
    Text1.Visible = False
    Set subItemToEdit = Nothing
  End If
End Sub

Private Sub Text1_LostFocus()
  ' abort
  Text1.Visible = False
  Set subItemToEdit = Nothing
  ListView1.Refresh
End Sub

HTH
TiKu

[Kriechi]

danke genau das hab ich gesucht!

danke

edit:
ich habe es nun ausprobiert, es funktioniert aber nur in deine samples die dabei waren, sowmit muss ich noch einige einstellung machen! nur welche
FullRowSelection True
AllowLabelEditing True

was noch?

bei mir ist die textbox immer ganz klein nur für 1 zeichn) und irgendwo links oben in der listview! nicht über dem subItemtoEdit!

bitte hilfe mir !

mfg
[hr]
Translation for visitors not speaking German:
Thanks, that was exactly what I was looking for!

Thanks

edit:
Now I've tried it, but it works in your samples only, so I have to change some properties! But which?
FullRowSelection True
AllowLabelEditing True

What else?

I get a very small textbox (for 1 character only) and it's placed somewhere in the listview's top-left corner and not above the subItemToEdit!

Please help me!

Kind regards

[TiKu]

Deine Form hat bestimmt einen anderen ScaleMode als Pixel, oder? Dann müsstest Du die Berechnung der Position entsprechend anpassen.
[hr]
Translation for visitors not speaking German:
Your form certainly uses another ScaleMode than pixels, am I right? Then you'd have to change the calculation of the position accordingly.

[Kriechi]

wow!
jetzt gehts!

danke
[hr]
Translation for visitors not speaking German:
Wow!
Now it works!

Thanks