VB6.0中LISTBOX的查找问题 5
剑小风老师,您好!请教您一个问题:VB中有一ListL控件,需要在Textbox1中输入关键字,点击COMMAND1后需要如下效果:1、ListL控件中若有该关键字,则将...
剑小风 老师,您好!
请教您一个问题:VB中有一ListL控件,需要在Textbox1中输入关键字,点击COMMAND1后需要如下效果:
1、ListL控件中若有该关键字,则将与该关键字有关的一行字体变红。
2、再次点击COMMAND1后,则查找下一个与该关键字有关的行,并将此行字体变红。
3、如此循环查找到ListL控件文本中的最后一行为止,并将与该关键字有关的所有行字体变红。
我是菜鸟,希望老师有详细的源码及注释,谢谢! 展开
请教您一个问题:VB中有一ListL控件,需要在Textbox1中输入关键字,点击COMMAND1后需要如下效果:
1、ListL控件中若有该关键字,则将与该关键字有关的一行字体变红。
2、再次点击COMMAND1后,则查找下一个与该关键字有关的行,并将此行字体变红。
3、如此循环查找到ListL控件文本中的最后一行为止,并将与该关键字有关的所有行字体变红。
我是菜鸟,希望老师有详细的源码及注释,谢谢! 展开
2个回答
展开全部
’
‘需要Command1 ,text1 ,listbox 3控件
’缺陷:有多行相符合条件的只显示最后一行的,自己改;变色后显示不完全,可以添加Label1来显示
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const LB_ITEMFROMPOINT = &H1A9
Private Const LB_GETITEMRECT = &H198
Private Const DT_LEFT = &H0
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Const TRANSPARENT = 1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush 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 Sub List1_Click()
Dim Lrect As RECT, LhDc As Long, hBrush As Long
Dim Ret As Long, lpStr As String
lpStr = List1.List(List1.ListIndex) 'List1.Text
Ret = SendMessage(List1.hwnd, LB_GETITEMRECT, List1.ListIndex, Lrect)
LhDc = GetDC(List1.hwnd)
Ret = FillRect(LhDc, Lrect, hBrush)
Ret = DeleteObject(hBrush)
Ret = SetBkMode(LhDc, TRANSPARENT)
Ret = SetTextColor(LhDc, RGB(255, 0, 0)) '选中条目字体颜色
Ret = DrawText(LhDc, lpStr, Len(lpStr), Lrect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER)
End Sub
Private Sub Command1_Click()
Dim i As Integer
For i = 0 To List1.ListCount - 1
If InStr(1, List1.List(i), Text1) <> 0 Then List1.Selected(i) = True
Next i
End Sub
‘需要Command1 ,text1 ,listbox 3控件
’缺陷:有多行相符合条件的只显示最后一行的,自己改;变色后显示不完全,可以添加Label1来显示
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const LB_ITEMFROMPOINT = &H1A9
Private Const LB_GETITEMRECT = &H198
Private Const DT_LEFT = &H0
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Const TRANSPARENT = 1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush 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 Sub List1_Click()
Dim Lrect As RECT, LhDc As Long, hBrush As Long
Dim Ret As Long, lpStr As String
lpStr = List1.List(List1.ListIndex) 'List1.Text
Ret = SendMessage(List1.hwnd, LB_GETITEMRECT, List1.ListIndex, Lrect)
LhDc = GetDC(List1.hwnd)
Ret = FillRect(LhDc, Lrect, hBrush)
Ret = DeleteObject(hBrush)
Ret = SetBkMode(LhDc, TRANSPARENT)
Ret = SetTextColor(LhDc, RGB(255, 0, 0)) '选中条目字体颜色
Ret = DrawText(LhDc, lpStr, Len(lpStr), Lrect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER)
End Sub
Private Sub Command1_Click()
Dim i As Integer
For i = 0 To List1.ListCount - 1
If InStr(1, List1.List(i), Text1) <> 0 Then List1.Selected(i) = True
Next i
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询