VB6 Цвет списка для выбранного элемента, когда список не имеет фокуса

Question

На Listview, который не имеет фокуса в Windows 10, Listview элементы выделяются очень слабо. Я знаю, что это зависит от системной темы.

На этом изображении выбран номер три.

Можно ли вообще что-то изменить программно, чтобы он был более темного оттенка серого и более заметным? В более ранних версиях Windows стандартная тема показала это как темно-серый.

Answer 1

Вот решение проблемы, которое работает хорошо. Он включает использование подклассов и выигрыш API-вызовов, поэтому, пожалуйста, будьте осторожны.

В этом коде используется компонент подклассов , предоставленный vbAccelerator , хотя вы должны быть в состоянии использовать любую технику подклассов. Таким образом, сообщение 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