关于Combox控件和ListBox控件字体颜色的问题！急！急!急！在线等

还有人用VB6吗 2006-09-13 08:48:14

请问各位有谁知道如何使Combox控件和ListBox控件改变的字体颜色（要求其中的数据字体颜色各不相同）

解决了马上结贴

...全文

704 10 打赏收藏转发到动态举报

写回复

用AI写文章

10 条回复

切换为时间正序

请发表友善的回复…

发表回复

还有人用VB6吗 2006-09-13

打赏
举报

老大，快帮哥们看看啊，怎么一运行就出来一个默认的控件啊，怎么隐藏啊，你有QQ吗，我的37266981，联系我啊

还有人用VB6吗 2006-09-13

打赏
举报

为什么要鼠标单击字段后才改变颜色？初始显示不对啊，老兄，帮调试看看

zq972 2006-09-13

打赏
举报

个人觉得楼上的已经给出充足的解决办法了

楼主先好好消化一下楼上的代码吧

还有人用VB6吗 2006-09-13

打赏
举报

老兄，怎么调用啊？

迈克揉索芙特 2006-09-13

打赏
举报

同意楼上的方法，用自绘。

hpygzhx520 2006-09-13

打赏
举报

你得自绘

''鬼龙之舞
''2003年8月11日
''=================================
''以下的代码复制到模块中
''如果你要修改wndproc里的东西,运行前请一定要保存,
''否则如果你的代码出错(包括像"变量未定义"这样的小错误),可能导致VB崩溃!!
Option Explicit
Private Const WM_DRAWITEM = &H2B
Private Const ODT_LISTBOX = 2
Private Const ODS_FOCUS = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private 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 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 Const LB_ADDSTRING = &H180
Public Const LB_SETITEMDATA = &H19A
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const LB_GETTEXT = &H189
Private Const LB_GETTEXTLEN = &H18A
Private 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
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public lpOldProc As Long, g_hList As Long
'===========
Public Function wndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_DRAWITEM Then
Dim dis As DRAWITEMSTRUCT, s As String * 260
'lParam传过来的是DRAWITEMSTRUCT的地址
CopyMemory dis, ByVal lParam, Len(dis)

If dis.CtlType = ODT_LISTBOX Then '如果是listbox
'随便填个背景色,主要是清除下面的DrawFocusRect画出的框

SendMessage dis.hwndItem, LB_GETTEXT, dis.itemID, ByVal s
s = Left(s, lstrlen(s))
SetBkMode dis.hdc, 1 '把画出的文字的背景设为透明
SetTextColor dis.hdc, dis.itemData
If dis.itemState = ODS_FOCUS Then '如果是当前项目
FillRect dis.hdc, dis.rcItem, 1
Else
FillRect dis.hdc, dis.rcItem, 0
End If
''---lstrlen()可以返回一个中英文混合字符串的正确长度
DrawText dis.hdc, s, lstrlen(s), dis.rcItem, &H4 '&H4 的其它值可以在API浏览器里查DT_??
End If
'我们处理了的消息就返回0
wndProc = 0
Exit Function
End If
'其它消息让程序处理
wndProc = CallWindowProc(lpOldProc, hwnd, Msg, wParam, lParam)
End Function

''鬼龙之舞
''2003年8月11日
''=================================
''新建一个标准工程,
''添加一个listbox到窗体上
''把listbox的Style设为1-CheckBox
''以下的代码复制到窗体中
''添加一个模块
Option Explicit
Private Const GWL_WNDPROC = (-4)
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const LBS_OWNERDRAWFIXED = &H10&
Private Const LBS_OWNERDRAWVARIABLE = &H20&
Private Const LBS_HASSTRINGS = &H40&
Private Const LBS_MULTICOLUMN = &H200&
Private Const LBS_MULTIPLESEL = &H8&
Private Const LBS_SORT = &H2&
Private Const EM_LIMITTEXT = &HC5
Private Const CB_LIMITTEXT = &H141
Private Sub Form_Load()
Dim i As Long, hListBox As Long
'用API来建立一个ListBox
hListBox = CreateWindowEx(&H200, "listbox", "", _
WS_CHILD Or WS_VISIBLE, _
List1.Left / 15, 10, List1.Width / 15, 100, _
Me.hwnd, 0, App.hInstance, 0)

i = SendMessage(hListBox, LB_ADDSTRING, 0, ByVal "用API建立的LISTBOX")
SendMessage hListBox, LB_SETITEMDATA, i, ByVal vbRed

i = SendMessage(hListBox, LB_ADDSTRING, 0, ByVal "鬼龙之舞")
SendMessage hListBox, LB_SETITEMDATA, i, ByVal vbBlue
i = SendMessage(hListBox, LB_ADDSTRING, 0, ByVal "http://kbadboy.yeah.net")
SendMessage hListBox, LB_SETITEMDATA, i, ByVal vbBlue
i = SendMessage(hListBox, LB_ADDSTRING, 0, ByVal "k_badboy@sohu.com")
SendMessage hListBox, LB_SETITEMDATA, i, ByVal vbBlue

i = SendMessage(hListBox, LB_ADDSTRING, 0, ByVal "^_^")
SendMessage hListBox, LB_SETITEMDATA, i, ByVal vbRed

With List1
.AddItem "自画ListBox"
.itemData(.NewIndex) = RGB(38, 89, 18) '将颜色保存在ItemData里
.AddItem "粉红"
.itemData(.NewIndex) = &HFF00FF '将颜色保存在ItemData里
.AddItem "红"
.itemData(.NewIndex) = vbRed
.AddItem "蓝"
.itemData(.NewIndex) = vbBlue
.AddItem "灰"
.itemData(.NewIndex) = QBColor(8)
.AddItem "黄"
.itemData(.NewIndex) = vbYellow
End With
lpOldProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, Val(AddressOf wndProc))
End Sub