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 CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
      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
              Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
              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
                      Else
                         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
        Next
       



    .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

    Regards

    DoctorMahdi

     

     

Post a reply

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

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

Contribute

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.

“Never trust a programmer in a suit.” - Anonymous