Sub RemoveDups(lst As Control, comptype As Boolean)
Dim lPos As Long '原始比对项目 index
Dim lCompPos As Long '待比对项目 index
Dim sComp As String '原始比对字串
Dim sComptype As Long '0(binary) / 1(textual) 比对
lPos = 0
If comptype Then sComptype = 0 Else sComptype = 1
Do While lPos < (lst.ListCount - 1)
sComp = lst.List(lPos)
lCompPos = lPos + 1
Do While lCompPos < lst.ListCount
If StrComp(sComp, lst.List(lCompPos), sComptype) = 0 Then
lst.RemoveItem lCompPos
lCompPos = lCompPos - 1
End If
lCompPos = lCompPos + 1
Loop
lPos = lPos + 1
Loop
End Sub
'在程序中使用方式如下:
'要分别大小写
Private Sub Command1_Click()
RemoveDups List1, True
RemoveDups Combo1, True
End Sub
'不分别大小写
Private Sub Command2_Click()
RemoveDups List1, False
RemoveDups Combo1, False
End Sub
If List1.ListCount > 0 Then
Dim i As Integer
For i = List1.ListCount To 0 Step -1
If List1.List(i) = Trim(Text1.Text) Then
List1.RemoveItem i
End If
Next i
End If
如果不用API
if list1.listcount>0 then
dim i as integer
For i =list.ListCount to 0 setp -1
If list.List(i) = Trim(text1.text) Then
list1.removeitem i
End If
Next i
end if
Private Const LB_FINDSTRINGEXACT = &H1A2
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 Sub Command1_Click()
Dim ls_FindString As String, ll_Rtn As Long
ls_FindString = Trim(Text1.Text) & Chr(0)
ll_Rtn = SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, -1, ByVal ls_FindString)
If ll_Rtn <> -1 Then List1.RemoveItem ll_Rtn
End Sub