Re: Question on ListView

  • 14 years ago

    Hi apol

    Here is the code from the second link:

    '====bas module code=====
    Option Explicit

      Public Const NM_CUSTOMDRAW = (-12&)
      Public Const WM_NOTIFY As Long = &H4E&
      Public Const CDDS_PREPAINT As Long = &H1&
      Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
      Public Const CDDS_ITEM As Long = &H10000
      Public Const CDRF_NEWFONT As Long = &H2&
      Public Type NMHDR
        hWndFrom As Long   ' Window handle of control sending message
        idFrom As Long        ' Identifier of control sending message
        code  As Long          ' Specifies the notification code
      End Type

      ' sub struct of the NMCUSTOMDRAW struct

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

    ' generic customdraw struct
      Public Type NMCUSTOMDRAW
        hdr As NMHDR
        dwDrawStage As Long
        hDC As Long
        rc As RECT
        dwItemSpec As Long
        uItemState As Long
        lItemlParam As Long
      End Type

    ' listview specific customdraw struct
      Public Type NMLVCUSTOMDRAW
        nmcd As NMCUSTOMDRAW
        clrText As Long
        clrTextBk As Long

    ' if IE >= 4.0 this member of the struct can be used

        'iSubItem As Integer
      End Type

      Public g_addProcOld As Long
      Public g_MaxItems As Long
      Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
      Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
    Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      Select Case iMsg
        Case WM_NOTIFY
          Dim udtNMHDR As NMHDR
          CopyMemory udtNMHDR, ByVal lParam, 12&
          With udtNMHDR
            If .code = NM_CUSTOMDRAW Then
              CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
              With udtNMLVCUSTOMDRAW.nmcd
                Select Case .dwDrawStage
                  Case CDDS_PREPAINT
                    WindowProc = CDRF_NOTIFYITEMDRAW
                    Exit Function
                  Case CDDS_ITEMPREPAINT
                      If Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Index) = 3 Then
                         udtNMLVCUSTOMDRAW.clrText = vbRed
                         udtNMLVCUSTOMDRAW.clrText = vbBlack
                      End If

    'You may also change BackColor same way:
    '                 udtNMLVCUSTOMDRAW.clrTextBk = Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Tag)
                      CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                      WindowProc = CDRF_NEWFONT
                      Exit Function
                End Select
              End With
            End If
          End With
      End Select
      WindowProc = CallWindowProc(g_addProcOld, hwnd, iMsg, wParam, lParam)
    End Function

    '=======Form code=======

    Option Explicit
    Private Const GWL_WNDPROC As Long = (-4&)
    Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)

    Private Sub Form_Load()
      With ListView1
        .FullRowSelect = True
        .ColumnHeaders.Add , , "Item Column"
        .ColumnHeaders.Add , , "Subitem 1"
        .ColumnHeaders.Add , , "Subitem 2"
        Dim i&
        For i = 1 To 30
          With .ListItems.Add(, , CStr(Int(200 * Rnd)))
            .SubItems(1) = "Subitem 1"
            .SubItems(2) = "Subitem 2"

    'I used Tag property to set back color
            .Tag = CStr(QBColor(i Mod 15))
          End With

    .ListItems(20).ForeColor = vbBlue

        g_MaxItems = .ListItems.Count - 1
      End With
      g_addProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
      Call SetWindowLong(hwnd, GWL_WNDPROC, g_addProcOld)
    End Sub

    'Note: This code use subclassing. So, don't stop it from IDE stop button, use form [x] button instead

    This code is not tested; remove the red line from the code it's only for test





Post a reply

No one has replied yet! Why not be the first?

Sign in or Join us (it's free).


Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“An idiot with a computer is a faster, better idiot” - Rich Julius