ListView Question

[Rev. Michael L. Burns]

Is there a way to make the data displayed in a ListView control to display alternate background colors so as to imulate greenbar papaer, ie every other row green?

Rev. Michael L. Burns

See this topic

[HeSaidJoe]

'have not tested this got it from another site I searched.
'if it works please drop me an email to let me know...then
'I won't waste time testing it..just add it to my sometime
'in the future code pile.

'---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 clr() 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 clr(.dwItemSpec) <> 0 Then 
'                    udtNMLVCUSTOMDRAW.clrText = vbRed 
                    udtNMLVCUSTOMDRAW.clrTextBk = clr(.dwItemSpec) 
                    CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW) 
                  End If 
                  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 

Public Sub SetLIBackColor(lv As ListView, nItem As Integer, BkColor As Long) 
   clr(nItem - 1) = BkColor 
   lv.Refresh 
End Sub 

'---Form code--- 
' Add ListView (lvCustomDraw) with 
'Report style, TextBox and Command Button 
' Start App. Print ListItem Number at etxtbox end press command button 

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 Command1_Click() 
  SetLIBackColor lvCustomDraw, Val(Text1), vbYellow 
End Sub 

Private Sub Form_Load() 
  lvCustomDraw.FullRowSelect = True 
  With lvCustomDraw 
    .ColumnHeaders.Add , , "Item Column" 
    .ColumnHeaders.Add , , "Subitem 1" 
    .ColumnHeaders.Add , , "Subitem 2" 
    Dim i& 
    For i = 1 To 30 
      With .ListItems.Add(, , "Item " & CStr(i)) 
        .SubItems(1) = "Subitem 1" 
        .SubItems(2) = "Subitem 2" 
      End With 
    Next 
  End With 
' Don't forget to redim array if you add/remove listview items 
  ReDim Preserve clr(lvCustomDraw.ListItems.Count) 
  g_MaxItems = lvCustomDraw.ListItems.Count - 1 
  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

[HeSaidJoe]

for some reason these smilies jump in the code so if you see a smilie it needs to be replace with whatever code puts the dumb thing on the page.
Works... I made a few changes but I'm not sure what..I think
some of it was to put the code in (where the smilies took it out and maybe one new set of constants.

' bas module code
' hook system and color the backcolor of rows different colors
' as with hooking if you unload using the stop button of Visual Basic
' and you don't use the unloadquerry (the X on the form)
' then windows will crash 
'
  Option Explicit
  
    Public Const GWL_EXSTYLE = -20
    Public Const GWL_HINSTANCE = -6
    Public Const GWL_HWNDPARENT = -8
    Public Const GWL_ID = -12
    Public Const GWL_STYLE = -16
    Public Const GWL_USERDATA = -21
    Public Const GWL_WNDPROC = -4
    Public Const DWL_DLGPROC = 4
    Public Const DWL_MSGRESULT = 0
    Public Const DWL_USER = 8

    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 clr() As Long


Public Declare Function SetWindowLong Lib "user32.dll" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

  
 Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
  (Destination As Any, Source As Any, ByVal Length As Long)
  
 Public Declare Function CallWindowProc Lib "user32.dll" Alias _
  "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
  ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
  ByVal lParam As Long) As Long
   
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 clr(.dwItemSpec) <> 0 Then
'change the color of the text display if wanted
'udtNMLVCUSTOMDRAW.clrText = vbBlue
               udtNMLVCUSTOMDRAW.clrTextBk = clr(.dwItemSpec)
               CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
       End If
           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

Public Sub SetLIBackColor(lv As ListView, nitem As Integer, BkColor As Long)
   clr(nitem - 1) = BkColor
   lv.Refresh
End Sub

Public Sub SetLIForeColor(lv As ListView, ForeColor As Long)
   clr(nitem - 1) = ForeColor
   lv.Refresh
End Sub

'<<<<<<<<<<<<<<<<<<<<<<<<<<   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'
'Form Code.

Option Explicit

Private Sub Form_Load()

  ListView1.FullRowSelect = True
  ListView1.View = lvwReport
  
  With ListView1
    .ColumnHeaders.Add , , "Item Column"
    .ColumnHeaders.Add , , "Subitem 1"
    .ColumnHeaders.Add , , "Subitem 2"
    Dim i&
    For i = 1 To 30
      With .ListItems.Add(, , "Item " & CStr(i))
        .SubItems(1) = "Subitem 1"
        .SubItems(2) = "Subitem 2"
      End With
    Next
  End With
  
' Don't forget to redim array if you add/remove listview items
  ReDim Preserve clr(ListView1.ListItems.Count)
  g_MaxItems = ListView1.ListItems.Count - 1
  g_addProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
 
  
End Sub

Private Sub Command1_Click()
'set the rows to different colors
  SetLIBackColor ListView1, 1, vbYellow
  SetLIBackColor ListView1, 2, vbRed
  SetLIBackColor ListView1, 3, vbMagenta
End Sub

Private Sub Form_Unload(Cancel As Integer)

  Call SetWindowLong(hWnd, GWL_WNDPROC, g_addProcOld)
End Sub