Option Explicit

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 SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private 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
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

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

Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * 50
End Type

Const LB_GETITEMRECT = 408

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 10: List1.AddItem i & "00" & "VB编程爱好者论坛": Next
Me.ScaleMode = vbPixels
End Sub

Private Function GetTextLengthA(ByVal strText) As Long '判断一个Ansi字符串的长度(一个中文字符长度为2，一个英文字符长度为1)
Dim intX As Integer
Dim lngTextLength As Long
lngTextLength = Len(strText) '返回Unicode的长度
For intX = 1 To lngTextLength
  If Asc(Mid$(strText, intX, 1)) < 0 Then lngTextLength = lngTextLength + 1 'Asc()：英文字符返回值大于零，中文字符返回值小于零
Next
GetTextLengthA = lngTextLength
End Function

Private Sub List1_Click()
Dim pRec As RECT
Dim pRgn As Long
Dim pFont As Long
Dim pBrush As Long
Dim pDC As Long
Dim lpLogFont As LOGFONT

SendMessage List1.hwnd, LB_GETITEMRECT, List1.ListIndex, pRec '得到列表框当前选中项目的矩形位置
pRgn = CreateRectRgn(pRec.Left, pRec.Top, pRec.Right, pRec.Bottom) '根据得到的矩形位置创建一个区域
pBrush = CreateSolidBrush(&H8000&)     '创建一个样式为Solid的刷子
pDC = GetDC(List1.hwnd) '得到列表框的Device Context
With lpLogFont '创建一个字体，并根据当前列表框中字体大小进行设置
  .lfHeight = TextHeight(List1.Text)
  .lfFaceName = "宋体" & Chr(0)
End With
pFont = CreateFontIndirect(lpLogFont)
pFont = SelectObject(pDC, pFont) '将创建的字体选入设备上下文
FillRgn pDC, pRgn, pBrush '用刷子对区域进行填充
SetTextColor pDC, 0&      '设置选中行的文字为黑色
SetBkColor pDC, &H8000&   '设置选中行的背景为绿色
TextOut pDC, pRec.Left, pRec.Top, ByVal List1.Text, GetTextLengthA(List1.Text) '输出文字
End Sub

十分感谢一江秋水的解答，但和我想要的效果有一点差距，我想要的效果是：

[img]d:\1.bmp[/img]

点击转换按钮后，那一行就永久变成绿色

OwnerDraw

可不可以讲得详细点

就是我点击了list控件里其中一行，然后再点击旁边那个按钮，那么我刚才点击list的那一行背景色变成绿色。
烦请各位大侠再指教一下。

请一江秋水大侠再指教

你把 List1_Click 替换成 Command1_Click 应该就可以了。
另外，可以删除代码中的GetTextLengthA函数，改用API函数lstrlen代替，更加精炼。lstrlen的声明是：
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

一江秋水大侠你好，谢谢你的指教，我按照你的说法， 把List1_Click 替换成 Command1_Click，
但是我点击第二行，然后点击Command1，第一行又变成了白色，请问大侠如何解决。

要达到你的要求，可能只有自己制作一个用户控件了。用户控件的制作可参看我以前的发贴。下面的代码只是作为应急的：

Dim lIndex() As Integer

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 10: List1.AddItem i & "00" & "VB编程爱好者论坛": Next
Me.ScaleMode = vbPixels
ReDim lIndex(0)
End Sub

Private Sub List1_Click()
Dim i As Integer
If UBound(lIndex) = 0 Then
  ReDim lIndex(1 To 1)
  lIndex(1) = List1.ListIndex
Else
  For i = 1 To UBound(lIndex)
    If List1.ListIndex = lIndex(i) Then i = 0: Exit For
  Next
  If i Then
    ReDim Preserve lIndex(1 To i)
    lIndex(i) = List1.ListIndex
  End If
End If

End Sub

Private Sub Command1_Click()
Dim pRec As RECT
Dim pRgn As Long
Dim pFont As Long
Dim pBrush As Long
Dim pDC As Long
Dim lpLogFont As LOGFONT
Dim i As Integer

For i = 1 To UBound(lIndex)
  SendMessage List1.hwnd, LB_GETITEMRECT, lIndex(i), pRec
  pRgn = CreateRectRgn(pRec.Left, pRec.Top, pRec.Right, pRec.Bottom)
  pBrush = CreateSolidBrush(&H8000&)
  pDC = GetDC(List1.hwnd)
  With lpLogFont
    .lfHeight = TextHeight(List1.Text)
    .lfFaceName = "宋体" & Chr(0)
  End With
  pFont = CreateFontIndirect(lpLogFont)
  pFont = SelectObject(pDC, pFont)
  FillRgn pDC, pRgn, pBrush
  SetTextColor pDC, 0&
  SetBkColor pDC, &H8000&
  TextOut pDC, pRec.Left, pRec.Top, ByVal List1.Text, lstrlen(List1.Text)
Next
End Sub