[Problem] ListView Example of how to display the site

[polosa]

Hi All

My English is not good.

I would like to know how to reach this site's functionality, using vb



http://www.codeproject.com/KB/list/LVCustomReordering.aspx

ListViewCustomReorderSrc Examples

[BlackZeroX]

Example in VB6...!¡.

http://vbasic.astalaweb.com/drag%20&%20drop/1_drag%20&%20drop.asp

Dulce Infierno Lunar!¡.

[polosa]

Hello, I made myself clear, please forgive me

I want to reach LISTVIEW in the function of the red lines, is not to use the function to complete custom DRAW

[LeandroA]

Hi, welcome to the Forum, this example is with the listview of Microsoft  Common Controls version  6, for the version 5 is more complicated.

ListViewDragWithLine.zip

Código: (Vb) [Seleccionar]

Option Explicit
'----------------------------------------
'Autor:     Leandro Ascierto
'Web:       www.leandroascierto.com.ar
'Date:      14/10/2010
'----------------------------------------
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpPoint As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function LineTo Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Const IDC_HAND = 32649&
 
Dim m_hCursor As Long
Dim m_IndexDrag As Long

Private Sub Form_Load()
    Dim LI As ListItem
    Dim i As Long
   
    ListView1.View = lvwReport
    ListView1.FullRowSelect = True
       
    For i = 0 To 3
        ListView1.ColumnHeaders.Add , , "Columna" & i
    Next
   
    For i = 0 To 100
        Set LI = ListView1.ListItems.Add(, , "Item" & i)
        LI.SubItems(1) = "SubItem 1"
        LI.SubItems(2) = "SubItem 2"
        LI.SubItems(3) = Now
    Next
End Sub

Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Call DragItem(ListView1, X, Y)
    End If
End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Call EndDragItem(ListView1)
    End If
End Sub

Public Sub EndDragItem(ObjListView As ListView)
    Dim LI As ListItem
    Dim i As Long
   
     If m_IndexDrag > 0 Then
        With ObjListView
            Set LI = .ListItems.Add(m_IndexDrag, , .SelectedItem.Text)
            For i = 1 To ListView1.ColumnHeaders.Count - 1
                LI.SubItems(i) = .SelectedItem.SubItems(i)
            Next
           
            .ListItems.Remove .SelectedItem.Index
            LI.Selected = True
            m_IndexDrag = 0
        End With
    End If
   
    If m_hCursor Then DestroyCursor m_hCursor: m_hCursor = 0
End Sub

Public Sub DragItem(ObjListView As ListView, ByVal X As Single, ByVal Y As Single)
    Dim lTop As Long

    Dim hdc As Long
    Dim PT As POINTAPI
    Dim ColH As ColumnHeader
    Dim MaxColumnWidth As Long
    Dim TheItemDrag As ListItem

    With ObjListView
        If .ListItems.Count = 0 Then Exit Sub
       
        If m_hCursor = 0 Then m_hCursor = LoadCursor(0&, IDC_HAND)
        SetCursor m_hCursor
       
        InvalidateRect .hwnd, ByVal 0&, False

        Set TheItemDrag = .HitTest(X, Y)

        If Not TheItemDrag Is Nothing Then

            Set ColH = .ColumnHeaders(.ColumnHeaders.Count)
            MaxColumnWidth = (ColH.Left + ColH.Width) / Screen.TwipsPerPixelX

            If Y - TheItemDrag.Top > TheItemDrag.Height / 2 Then
                lTop = (TheItemDrag.Top + TheItemDrag.Height) / Screen.TwipsPerPixelY
                m_IndexDrag = TheItemDrag.Index + IIf(.SelectedItem.Index < TheItemDrag.Index, 1, 0)
            Else
                lTop = TheItemDrag.Top / Screen.TwipsPerPixelY
                m_IndexDrag = TheItemDrag.Index
            End If
                     
            DoEvents
           
            hdc = GetDC(.hwnd)
            DrawLine hdc, 2, lTop, MaxColumnWidth - 1, lTop, vbRed, 1
            ReleaseDC 0&, hdc
        End If
       
    End With

End Sub

Public Sub DrawLine(ByVal hdc As Long, _
                    ByVal X1 As Long, _
                    ByVal Y1 As Long, _
                    ByVal X2 As Long, _
                    ByVal Y2 As Long, _
                    Optional ByVal Color As Long = -1, _
                    Optional ByVal BorderWidth As Long = 1)
 
    Dim hPen As Long
    Dim hBrush As Long
    Dim TransColor As Long
    Dim OldPen As Long
    Dim OldBrush As Long
    Dim PT(2) As POINTAPI
 
    If Color <> -1 Then
        Call OleTranslateColor(Color, 0&, TransColor)
        hPen = CreatePen(0, BorderWidth, TransColor)
        OldPen = SelectObject(hdc, hPen)
        hBrush = CreateSolidBrush(Color)
        OldBrush = SelectObject(hdc, hBrush)
    End If
 
    If X1 >= 0 Then
        MoveToEx hdc, X1, Y1, 0
    End If
 
    LineTo hdc, X2, Y2
   
    PT(0).X = X1:       PT(0).Y = Y1 - 3
    PT(1).X = 5:        PT(1).Y = Y1
    PT(2).X = X1:       PT(2).Y = Y1 + 3
   
    Polygon hdc, PT(0), 3
   
    PT(0).X = X2:       PT(0).Y = Y2 - 3
    PT(1).X = X2 - 5:   PT(1).Y = Y2
    PT(2).X = X2:       PT(2).Y = Y2 + 3
   
    Polygon hdc, PT(0), 3
   
    If Color <> -1 Then
        DeleteObject SelectObject(hdc, OldPen)
        DeleteObject SelectObject(hdc, OldBrush)
    End If
 
End Sub


[polosa]

HI

After the test is ok

But I want to use the API methods do not know if I used the following method, but an error.

Código: [Seleccionar]


Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMPOSITION = (LVM_FIRST + 16)

Private Function GetPositionY(ByVal iIndex As Long) As Long
    Dim tP As POINTAPI
   
   SendMessageW ucListView.hwnd, LVM_GETITEMPOSITION, iIndex, tP
   
   GetPositionY= tP.Y
End Function

lTop = GetPositionY(ucListView.GetSelectedItem)


I used the following components at the control

http://www.leandroascierto.com.ar/categoria/Proyectos/articulo/Explorador%20Remoto.php

How do I make. I'm sorry you had trouble.

[ssccaann43]

Leandro..! Que Groso..!

[raul338]

Tambien funciona perfectamente para la version 5... aunque claro, hay que implementar el FullRowSelect a mano 

[LeandroA]

Tambien funciona perfectamente para la version 5... aunque claro, hay que implementar el FullRowSelect a mano 

mira vos, ni me habia fijado que la version 5 tenia las propiedades Item  .Height, .HitTest, .Top, asi que claro solo basta con utilar sendmessage par habilitar el FullRowSelect

@polosa use LVM_GETITEMRECT

Código: [Seleccionar]

Option Explicit
Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

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

Private Function GetItemTop(ByVal iIndex As Long) As Long
    Dim Rec As RECT
   
   SendMessage ucListView.hwnd, LVM_GETITEMRECT, iIndex, Rec
   
   GetItemTop = Rec.Top
End Function

Private Function GetItemHeight(ByVal iIndex As Long) As Long
    Dim Rec As RECT
   
   SendMessage ucListView.hwnd, LVM_GETITEMRECT, iIndex, Rec
   
   GetItemHeight = Rec.Bottom - Rec.Top
End Function


[polosa]

Tested. Has been a success. Thank you.

In addition, I have slightly modified the code. And add a special effect.

Let the line looks perfect.

Código: [Seleccionar]

Public Sub DrawLine(ByVal hdc As Long, _
                    ByVal X1 As Long, _
                    ByVal Y1 As Long, _
                    ByVal X2 As Long, _
                    ByVal Y2 As Long, _
                    Optional ByVal Color As Long = -1, _
                    Optional ByVal BorderWidth As Long = 1)
 
    Dim hPen       As Long
    Dim hBrush     As Long
    Dim TransColor As Long
    Dim OldPen     As Long
    Dim OldBrush   As Long
    Dim pt(2)      As POINTAPI
 
    If Color <> -1 Then
        Call OleTranslateColor(Color, 0&, TransColor)
        hPen = CreatePen(0, BorderWidth, TransColor)
        OldPen = SelectObject(hdc, hPen)
        hBrush = CreateSolidBrush(Color)
        OldBrush = SelectObject(hdc, hBrush)
    End If
 
    If X1 >= 0 Then MoveToEx hdc, X1, Y1, 0
 
    LineTo hdc, X2, Y2
   
    pt(0).X = X1:       pt(0).Y = Y1 - 3
    pt(1).X = X1 + 5:        pt(1).Y = Y1
    pt(2).X = X1:       pt(2).Y = Y1 + 3
   
    Polygon hdc, pt(0), 3
   
    pt(0).X = X2:       pt(0).Y = Y2 - 3
    pt(1).X = X2 - 5:   pt(1).Y = Y2
    pt(2).X = X2:       pt(2).Y = Y2 + 3
   
    Polygon hdc, pt(0), 3
   
    If Color <> -1 Then
        DeleteObject SelectObject(hdc, OldPen)
        DeleteObject SelectObject(hdc, OldBrush)
    End If
End Sub
Private Function RenderGradient(ByVal hdc As Long, _
                                ByVal X As Long, _
                                ByVal Y As Long, _
                                ByVal Width As Long, _
                                ByVal Height As Long)
    Dim A      As Long
    Dim Perc   As Single
    Dim vRed   As Long
    Dim vGreen As Long
    Dim vBlue  As Long
       
    For A = 0 To Height
        Perc = 1 - (A / Height)
       
        vRed = (61 * Perc) + (37 * (1 - Perc))
        vGreen = (132 * Perc) + (80 * (1 - Perc))
        vBlue = (246 * Perc) + (148 * (1 - Perc))
       
        DrawLine hdc, X, Y + A, Width, Y + A, RGB(vRed, vGreen, vBlue)
    Next
End Function

            'DrawLine hdc, 2, lTop, MaxColumnWidth - 1, lTop, vbRed, 1
            RenderGradient hdc, 2, lTop, MaxColumnWidth - 1, 1