border on entire row in listview 1

[sal21]

Possible to have a thin border around a complete row in listview instead the dark row select....?
Naturally only when the row is clicked or in click_item event.
Tks.
see image.
tks

 

[strongm]

Well, not easily in VB6

Basically you'll need to subclass, and implement OwnerDraw functionality, a fairly comprehensive example of which can be found here

The bit you are most interested in is under the

[tt]If Form1.chkBorderOnly.Value = 1 Then[/tt]

in the plCustomDraw proc - but you'll need to understand how to put all the necessary supporting code into place as well

 

[sal21]

HUMMMMM....
tks for tips but not for me.
Can you post a simple project?
Tks bro

 

[strongm]

>Can you post a simple project?

I didn't post this to give you a hard project - this is pretty much what you need to do if you elect to use OwnerDraw (the name is the clue - if you use it, you have to takeover most/all of the drawing of all the elements that make up the control, element by element, line by line) - and if you want to do what you have asked ... then you really need ownerdraw; I posted it to show you are asking a hard question - how to change the behaviour of a custom VB6 control.

And I've just realised that your screenshot is of the output of the example I linked, so you were already aware of that it would seem.

Suffice it to say that, whilst that e3xample can be simplified a bit -since it illustrates one or two additional features you do not seem to want (so far), such as additional icon columns, smarter icon redrawing, custom sporting and extended tooltips, what you are left with is still fairly complex involving subclassing, and low-level API work.

But if a) we just simplify it for you and b) just provide boilerplate solution then you won't gain an understanding of what is going on here and thus lose the ability to simply extend the code to support new functionality such as your request in thread222-1803733

 

[strongm]

Covid-19 lockdown provided an idle hour or so, so I simplified the code for you. This is NOT production code, simply workiong code that show it is possible to do what you requested,


Assumes you have a form (Form1) with

1) Imagelist set to 16x16 resolution, and with a single image at Index 1
2) Listview (ListView1)with 4 column headers, with FullRowSelect set to True, and with the ListView's Normal and Small icon image lists set to the ImageList above
3) 2 x Checkboxes; chkNoFocus and chkBorderOnly, default values preferably set to 1 - Checked


The following code goes in the Form module:

[blue][COLOR=green]' Derived from an enhanced Listview example written by Yumashin Alexey available on FreeVBCode.com [URL unfurl="true"]http://www.freevbcode.com/ShowCode.asp?ID=7175[/URL][/color]
Option Explicit

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

Private Sub chkNoFocus_Click()
    ListView1.Refresh
    ListView1.SetFocus
End Sub

Private Sub chkBorderOnly_Click()
    ListView1.SetFocus
    ListView1.Refresh
End Sub

Private Sub Form_Activate()
    If Not OnceExecuted Then
        PopulateListView
        SubClass Me.hWnd
        OnceExecuted = True
    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()
    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 ListView1.hWnd
        
    ListView1.ColumnHeaders(4).Width = 0
        
    For i = 1 To 30
        Set lvItem = ListView1.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 = 1
            .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
        
    ListView1.SortOrder = lvwDescending
    ListView1.ListItems(1).Selected = True
    
    LockWindowUpdate 0&
End Sub[/blue]

And a normal module with the following code:

[blue][COLOR=green]' Derived from an enhanced Listview example written by Yumashin Alexey available on FreeVBCode.com [URL unfurl="true"]http://www.freevbcode.com/ShowCode.asp?ID=7175[/URL][/color]
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
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
Public Declare Function CallWindowProc Lib "user32" 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DrawIconEx Lib "user32.dll" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long

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

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type NMHDR
    hwndFrom As Long
    idfrom As Long
    code As Long
End Type

Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hdc As Long
    rc As RECT
    dwItemSpec As Long ' this is control specific, but it's how to specify an item.  valid only with CDDS_ITEM bit set
    uItemState As Long
    lItemlParam As Long
End Type

Private Type NMLVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    iSubItem As Long
End Type

Private Type lvItem
    mask As Long
    iItem As Long
    iSubItem As Long
    state As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

Public Const GWL_WNDPROC = (-4)

Private Const DI_NORMAL As Long = &H3

Private Const NM_FIRST As Long = 0
Private Const NM_CUSTOMDRAW As Long = (NM_FIRST - 12)
Private Const WM_NOTIFY As Long = &H4E

' CustomDraw paint stages.
Private Const CDDS_PREPAINT = &H1
Private Const CDDS_ITEMPREPAINT = (&H10000 Or &H1)
Private Const CDDS_ITEMPOSTPAINT = (&H10000 Or &H2)

' CustomDraw return values.
Private Const CDRF_NOTIFYITEMDRAW = &H20
Private Const CDRF_NOTIFYPOSTPAINT As Long = &H10
Private Const CDRF_DODEFAULT As Long = &H0
Private Const CDRF_NEWFONT As Long = &H2

Private Const CDIS_FOCUS As Long = &H10
Private Const CDIS_SELECTED As Long = &H1

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_ICON As Long = 1
Private Const LVIR_BOUNDS As Long = 0

Public mhWndSubClassed As Long
Public mWndProcNext As Long

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)
        If tNMH.hwndFrom = Form1.ListView1.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
            
            ' Tell it we want to be told when an item is drawn.
            plCustomDraw = CDRF_NOTIFYITEMDRAW
            
        Case CDDS_ITEMPREPAINT
            
            If Not (NMLVCD.nmcd.lItemlParam = 0) Then
                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
                
                CopyMemory ByVal lParam, NMLVCD, lLen
                
            End If
            
            plCustomDraw = CDRF_NOTIFYPOSTPAINT
            
        Case CDDS_ITEMPOSTPAINT
                       
            ' ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
            If Form1.chkBorderOnly.Value = 1 Then
                ' replacing color filling with border:
                If lvRowIndex + 1 = Form1.ListView1.SelectedItem.Index Then
                    rct.Left = LVIR_ICON
                    SendMessage Form1.ListView1.Hwnd, LVM_GETITEMRECT, lvRowIndex, rct
                    tmp = rct.Left
                    rct.Top = Form1.ListView1.ColumnHeaders.Count - 2 ' << "2", ò.ê. ïîñëåäíÿÿ êîëîíêà - äëÿ ñîðòèðîâêè
                    rct.Left = LVIR_BOUNDS
                    SendMessage Form1.ListView1.Hwnd, LVM_GETSUBITEMRECT, lvRowIndex, rct
                    rct.Left = tmp
                    
                    hBr = CreateSolidBrush(RGB(0, 127, 0)) 'GetSysColorBrush(bdrColor)
                    FrameRect NMLVCD.nmcd.hdc, rct, hBr
                    DeleteObject hBr
                End If
            End If
            
            plCustomDraw = CDRF_NEWFONT
            
        Case Else
            plCustomDraw = CDRF_DODEFAULT
            
    End Select
    
End Function[/blue]

All of which should produce something like:

 

[strongm]

Did this help?

 

[sal21]

Hi Strongm!
No Word!!!!
The code work perfect!
PIzza from Napoli?

 

[sal21]

hummmmm....
i dont see the superior line on listitem.?

 

[strongm]

Yes, because you switched gridlines on which overdraw the custom draw. But seriously, you can't see how to solve this? It is one line of code ...

[blue]        Case CDDS_ITEMPOSTPAINT
                       
            [COLOR=green]' ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::[/color]
            If Form1.chkBorderOnly.Value = 1 Then
                [COLOR=green]' replacing color filling with border:[/color]
                If lvRowIndex + 1 = Form1.ListView1.SelectedItem.Index Then
                    rct.Left = LVIR_ICON
                    SendMessage Form1.ListView1.Hwnd, LVM_GETITEMRECT, lvRowIndex, rct
                    tmp = rct.Left
                    rct.Top = Form1.ListView1.ColumnHeaders.Count - 2 ' << "2", &ograve;.ê. ïîñëåäíÿÿ êîëîíêà - äëÿ ñîð&ograve;èðîâêè
                    rct.Left = LVIR_BOUNDS
                    SendMessage Form1.ListView1.Hwnd, LVM_GETSUBITEMRECT, lvRowIndex, rct
                    rct.Left = tmp
                    [b][COLOR=#EF2929]rct.Top = rct.Top + 1[/color][/b]
                    hBr = CreateSolidBrush(RGB(0, 127, 0)) 'GetSysColorBrush(bdrColor)
                    FrameRect NMLVCD.nmcd.hdc, rct, hBr
                    DeleteObject hBr
                End If
            End If[/blue]

 

[sal21]

strongm, the best!
Tks for code and your time.
You saved me.
Tks.