在 vb6 中更改一些列表框项目的颜色

Question

如何在vb6中改变Listbox控件中某些项目的前景色

除了使用Listview控件还有其他方法吗

Answer 1

我想您可以使用 MSFlexGrid/MSHFlexGrid 控件，只有 1 列并且 GridLines 属性设置为 0 - flexGridNone。要更改单个网格单元格的前景色，请使用 CellForeColor 属性.

Answer 2

这个问题可以通过使用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

模块

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

在 vb6 中更改一些列表框项目的颜色

change some listbox items fore color in vb6

listbox

vb6