изменить цвет некоторых элементов списка в vb6

Question

Как изменить цвет переднего края некоторых элементов в элементе управления Listbox в vb6.

Есть ли другой метод, кроме использования элемента управления Listview.

Answer 1

Эту проблему можно решить с помощью WinAPI. Следующий код показывает, как.

введите описание изображения здесь

Форма

Код формы заполняет список и устанавливает подклассы. Форма подклассифицируется, поэтому мы можем перехватывать сообщения в Listbox. Обязательно освободить подкласс в методе Unload, чтобы предотвратить неприятные сбои. ColorList - это метод, который windows вызывает для выполнения необходимой работы с использованием цвета переднего плана, хранящегося в ItemData.

Option Explicit

Private Sub Form_Load()
   Dim i As Integer
   
   For i = 1 To 10
      List1.AddItem "Item " & i
      List1.itemData(List1.NewIndex) = IIf(i Mod 2 = 0, vbBlue, vbRed) 'store the required color
   Next

   
   PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf ColorList)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   SetWindowLong hwnd, GWL_WNDPROC, PrevWndProc
End Sub

Module

Метод ColorList перехватывает Сообщение WM_DRAWITEM, поэтому способ рисования элемента можно изменить. Отрисовывается либо прямоугольник фокуса, либо цвет переднего плана, указанный при заполнении списка.

Option Explicit

Public Function ColorList(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim Item As DRAWITEMSTRUCT
   Dim Buffer As String * 255
   Dim ItemText As String
   Dim Brush As Long
   
   If Msg = WM_DRAWITEM Then
      CopyMemory Item, ByVal lParam, Len(Item)

      If Item.CtlType = ODT_LISTBOX Then
         'get the item
         SendMessage Item.hwndItem, LB_GETTEXT, Item.itemID, ByVal Buffer
         ItemText = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
         
         'draw the item
         If (Item.itemState And ODS_FOCUS) Then
            Brush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
            FillRect Item.hdc, Item.rcItem, Brush
            SetBkColor Item.hdc, GetSysColor(COLOR_HIGHLIGHT)
            SetTextColor Item.hdc, GetSysColor(COLOR_HIGHLIGHTTEXT)
            TextOut Item.hdc, Item.rcItem.Left, Item.rcItem.Top, ByVal ItemText, Len(ItemText)
            DrawFocusRect Item.hdc, Item.rcItem
         Else
            Brush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
            FillRect Item.hdc, Item.rcItem, Brush
            SetBkColor Item.hdc, GetSysColor(COLOR_WINDOW)
            SetTextColor Item.hdc, Item.itemData
            TextOut Item.hdc, Item.rcItem.Left, Item.rcItem.Top, ByVal ItemText, Len(ItemText)
         End If
         
         'cleanup
         DeleteObject Brush
         ColorList = 0
      End If
   Else
      ColorList = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
   End If
End Function

Также в модуле есть все необходимые определения.

Option Explicit

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

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

Public Type DRAWITEMSTRUCT
   CtlType As Long
   CtlID As Long
   itemID As Long
   itemAction As Long
   itemState As Long
   hwndItem As Long
   hdc As Long
   rcItem As RECT
   itemData As Long
End Type

Public Const GWL_WNDPROC = (-4)
Public Const LB_GETTEXT = &H189
Public Const WM_DRAWITEM = &H2B
Public Const COLOR_HIGHLIGHT = 13
Public Const COLOR_HIGHLIGHTTEXT = 14
Public Const COLOR_WINDOW = 5
Public Const COLOR_WINDOWTEXT = 8
Public Const ODS_FOCUS = &H10
Public Const ODT_LISTBOX = 2

Public PrevWndProc As Long

Answer 2

Я думаю, вы могли бы использовать элемент управления MSFlexGrid / MSHFlexGrid только с 1 столбцом и свойствами GridLines, установленными на 0 - flexGridNone. Чтобы изменить цвет переднего края отдельной ячейки сетки, используйте свойство CellForeColor.