change color of row when click in listview item 1

[sal21]

change color of row when click in listview item...

instead the blue color, as image attached

 

[strongm]

No, sadly not easy.

The VB6 version of the Lisview (i.e the one in the common controls library) does not support a different highlight colour (the vb.net version does, but we can't use that). The is no Windows message, API call or API macro that gives us a way to do this.

So to achieve what you are asking, you need to resort - once more - to OwnerDraw (it's only about another 3 or 4 lines of code). The core example for ownerdraw on a listview was provided to you a while back. Here is a link: thread222-1803482

 

[sal21]

ok tks, but...

For strongm...

Hi strongm, based this post :

https://www.tek-tips.com/viewthread.cfm?qid=180348...

how to use the code with 2 or more listview?

Possible to create a public sub function an pass th new paremeter LV as Listview

 

[strongm]

Heres a minor modification of my original example (mostly removing and/or commenting out unneccessary code). It demonstartews more than one Listview, and also the highlight colour (which can be anything we like)

End result looks a bit like: [URL unfurl="true"]https://res.cloudinary.com/engineering-com/video/upload/v1648474575/tips/Untitled_jtqfoa.mp4[/url]

You'll need a form with two listviews, a command button and a CommonDialog control

In the form paste the following code:

[COLOR=blue]Option Explicit

Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
Private Const LVIF_IMAGE = &H2
Private OnceExecuted As Boolean

[COLOR=green]'Private Sub chkNoFocus_Click()
'    ListView1.Refresh
'    ListView1.SetFocus
'End Sub

'Private Sub chkBorderOnly_Click()
'    ListView1.SetFocus
'    ListView1.Refresh
'End Sub[/color]

[b]Private Sub Command1_Click()
    SelectColour
End Sub[/b]

Private Sub Form_Activate()
    If Not OnceExecuted Then
    [COLOR=green]' let's do 2 listviews[/color]
        [b]PopulateListView ListView1
        PopulateListView ListView2[/b][b][/b]
        SubClass Me.hWnd
        OnceExecuted = True
        LVHighlighColour = vbBlue
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnSubClass
    Set Form1 = Nothing
End Sub

Private Sub SubClass(ByVal hWnd As Long)
    UnSubClass
    mWndProcNext = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    If mWndProcNext Then mhWndSubClassed = hWnd
End Sub

Private Sub UnSubClass()
    If mWndProcNext Then
        SetWindowLong mhWndSubClassed, GWL_WNDPROC, mWndProcNext
        mWndProcNext = 0
    End If
End Sub

Private Sub PopulateListView([b]lv As ListView[/b])
    Dim oldExStyle As Long
    Dim i As Integer
    Dim st As String
    Dim tmp As Single
    Dim lvItem As ListItem
    Dim j As Integer
    
    LockWindowUpdate [b]lv[/b].hWnd
        
    [b]lv[/b].ColumnHeaders(4).Width = 0
        
    [COLOR=green]' Some of the stuff in here will not display in custom ownerdraw mode (e.g red color, bold), but cannot be bothered to modifiy for sake of this example[/color]
    For i = 1 To 30
        Set lvItem = [b]lv[/b][b][/b].ListItems.Add(i, , "This item contains text " & i, 3, 3)
        With lvItem
            .Tag = ""
            st = Format$(DateSerial(2005, 1, 31 - i), "dd.mm.yyyy")
            .ListSubItems.Add 1, , st
            .ListSubItems(1).Tag = Format$(st, "yyyymmddHHMMSS")
            tmp = Rnd * 10000
            .ListSubItems.Add 2, , Format$(tmp, ".0000")
            .ListSubItems(2).Tag = Format$(tmp, "000000000000.0000000000")
            .ListSubItems.Add 3, , ""
            .ListSubItems(3).Tag = ""
            .SmallIcon = 3
            .Bold = (i Mod 3 = 0)
            .ListSubItems(1).Bold = (i Mod 3 = 0)
            .ListSubItems(2).Bold = (i Mod 3 = 0)
            If i Mod 4 = 0 Then
                .ForeColor = vbRed
                For j = 1 To .ListSubItems.Count
                    .ListSubItems(j).ForeColor = vbRed
                Next
            End If
        End With
    Next
        
    [b]lv[/b][b][/b].SortOrder = lvwDescending
    [b]lv[/b].ListItems(1).Selected = True
    
    LockWindowUpdate 0&
End Sub[/color]

And then in a Module:

[COLOR=blue]Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)
Private Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)

Private Const LVIR_LABEL As Long = 2
Private Const LVIR_ICON As Long = 1
Private Const LVIR_BOUNDS As Long = 0

Public mhWndSubClassed As Long
Public mWndProcNext As Long

[b]Public LVHighlighColour As Long[/b]

[b]Public Sub SelectColour()
 [COLOR=green]     ' Set Cancel to True[/color]
        With Form1.CommonDialog1
            .CancelError = True
            On Error GoTo ErrHandler
 [COLOR=green]           'Set the Flags property[/color]
            .Flags = cdlCCRGBInit
 [COLOR=green]           ' Display the Color Dialog box[/color]
            .ShowColor
[COLOR=green]            ' Set the form's background color to selected color[/color]
            LVHighlighColour = .Color
            Exit Sub
        End With

ErrHandler:
[COLOR=green]  ' User pressed the Cancel button[/color]
End Sub[/b]


Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Dim tNMH As NMHDR
    
    If uMsg = WM_NOTIFY Then
        CopyMemory tNMH, ByVal lParam, Len(tNMH)
[COLOR=green]        ' Hardcoded cheap way of working with individual LVs - handling LV1 and LV2 here
        ' Essentially, we ned to call plCustomDraw p0assing the correct lParam for each LV we are handling[/color]
        If tNMH.hwndFrom = Form1.ListView1.hWnd And tNMH.code = NM_CUSTOMDRAW Then
            WindowProc = plCustomDraw(lParam)
            Exit Function
        End If
        If tNMH.hwndFrom = Form1.ListView2.hWnd And tNMH.code = NM_CUSTOMDRAW Then
            WindowProc = plCustomDraw(lParam)
            Exit Function
        End If
    End If
    WindowProc = CallWindowProc(mWndProcNext, hWnd, uMsg, wParam, ByVal lParam)
    
End Function

Private Function plCustomDraw(ByVal lParam As Long) As Long
    Dim NMLVCD As NMLVCUSTOMDRAW
    Dim lLen As Long
    Dim hFont As Long
    Dim lvRowIndex As Long
    Dim rct As RECT
    Dim hBr As Long, bgColor As Long, bdrColor As Long, tmp As Long
    Dim LVI As lvItem
    
    ' Get the CustomDraw data.
    lLen = Len(NMLVCD)
    
    CopyMemory NMLVCD, ByVal lParam, lLen
    lvRowIndex = NMLVCD.nmcd.dwItemSpec
    
    Select Case NMLVCD.nmcd.dwDrawStage
        
        Case CDDS_PREPAINT
            
            [COLOR=green]' Tell it we want to be told when an item is drawn.[/color]
            plCustomDraw = CDRF_NOTIFYITEMDRAW
            
        Case CDDS_ITEMPREPAINT
            
            If Not (NMLVCD.nmcd.lItemlParam = 0) Then
[COLOR=green]'                If Form1.chkNoFocus.Value = 1 Then
'                    ' removing focus rect:
'                    NMLVCD.nmcd.uItemState = NMLVCD.nmcd.uItemState And (Not CDIS_FOCUS)
'                End If
                
'                If Form1.chkBorderOnly.Value = 1 Then
'                    ' removing standard selection:
'                    NMLVCD.nmcd.uItemState = NMLVCD.nmcd.uItemState And (Not CDIS_SELECTED)
'                End If[/color]
                
                
                [b]If NMLVCD.nmcd.uItemState And CDIS_SELECTED Then
                    NMLVCD.clrTextBk = LVHighlighColour[/b]
                    NMLVCD.nmcd.uItemState = NMLVCD.nmcd.uItemState And (Not CDIS_SELECTED)
                [b]End If[/b]
                
                
                CopyMemory ByVal lParam, NMLVCD, lLen
                
            End If
            
            plCustomDraw = CDRF_NOTIFYPOSTPAINT
            
        Case CDDS_ITEMPOSTPAINT
                       
            ' ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[COLOR=green]'            If Form1.chkBorderOnly.Value = 1 Then
'                ' replacing color filling with border:
'                If lvRowIndex + 1 = Form1.ListView1.SelectedItem.Index Then
'                    rct.Left = LVIR_BOUNDS 'LVIR_LABEL 'LVIR_ICON
'                    SendMessage Form1.ListView1.hWnd, LVM_GETITEMRECT, lvRowIndex, rct
''                    tmp = rct.Left
''                    rct.Top = Form1.ListView1.ColumnHeaders.Count - 2 '
''                    rct.Left = LVIR_BOUNDS
''                    SendMessage Form1.ListView1.hWnd, LVM_GETSUBITEMRECT, lvRowIndex, rct
''                    rct.Left = tmp
''                   We can use hitTest to track which subitem is under cursor
'                    rct.Top = rct.Top + 1
'
'                    hBr = CreateSolidBrush(RGB(0, 127, 0)) 'GetSysColorBrush(bdrColor)
'                    FrameRect NMLVCD.nmcd.hdc, rct, hBr
'                    'FillRect NMLVCD.nmcd.hdc, rct, hBr
'                    DeleteObject hBr
'                End If
'            End If[/color]
            
            plCustomDraw = CDRF_NEWFONT
            
        Case Else
            plCustomDraw = CDRF_DODEFAULT
            
    End Select
    
End Function[/color]

 

[sal21]

I READ NOW YOUR ANSWER...

WOW!!!!!
tKS for patience.
Sal.