列表没有焦点时所选项目的VB6 Listview颜色

Question

在Windows 10中没有重点关注的Listview上，Listview项非常模糊地突出显示。我知道这取决于系统主题。

在此图像中，选择了项目编号3。

有没有办法以编程方式更改此设置，从而使它成为更深的灰色阴影并且更明显。在Windows的早期版本中，标准主题将其显示为深灰色。

Answer 1

这里是解决问题的解决方案。它涉及使用子类化和win api调用，因此请谨慎操作。

此代码使用了 vbAccelerator 提供的subclassing component，尽管您应该可以使用任何子类化技术。总之，KillFocus消息被覆盖以实现我们的目标。

Option Explicit

Implements ISubclass

Private Const LVS_SHOWSELALWAYS As Long = &H8
Private Const LVIS_FOCUSED      As Long = &H1
Private Const LVM_FIRST         As Long = &H1000
Private Const LVM_GETNEXTITEM   As Long = (LVM_FIRST + 12)
Private Const LVM_SETITEMSTATE  As Long = (LVM_FIRST + 43)
Private Const LVNI_FOCUSED      As Long = &H1
Private Const LVNI_SELECTED     As Long = &H2
Private Const WM_SETFOCUS       As Long = &H7
Private Const WM_KILLFOCUS      As Long = &H8

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
   iGroupId   As Long
   cColumns   As Long
   puColumns  As Long
   piColFmt   As Long
   iGroup     As Long
End Type

Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Sub Form_Load()
   ListView1.ListItems.Add , , "Item Number One"
   ListView1.ListItems.Add , , "Item Number Two"
   ListView1.ListItems.Add , , "Item Number Three"
   ListView1.ListItems.Add , , "Item Number Four"
   ListView1.ListItems.Add , , "Item Number Five"
   ListView1.ListItems(3).Selected = True

   AttachMessage Me, ListView1.hWnd, WM_KILLFOCUS
End Sub

Private Sub Form_Unload(Cancel As Integer)
   DetachMessage Me, ListView1.hWnd, WM_KILLFOCUS
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer6.EMsgResponse)
'
End Property

Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
   ISubclass_MsgResponse = emrConsume
End Property

Private Function ISubclass_WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim i As Long
   Dim lvi As LVITEM

   Select Case iMsg
      Case WM_KILLFOCUS
         'get selected item and remove focus
         i = SendMessageW(hWnd, LVM_GETNEXTITEM, -1&, ByVal LVNI_FOCUSED Or LVNI_SELECTED)

         If i <> -1 Then
            lvi.StateMask = LVIS_FOCUSED
            SendMessageW hWnd, LVM_SETITEMSTATE, i, lvi
         End If

         'return 1 to indicate we processed the message
         ISubclass_WindowProc = 1
   End Select
End Function