خودم پیداش کردم
Option Explicit
Private m_lngPreviousRow As Long
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_HITTEST As Long = (LVM_FIRST + 18)
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type LVHITTESTINFO
pt As POINTAPI
flags As Long
iItem As Long
iSubItem As Long
End Type
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
'this public sub would probably be in a .bas module
Public Sub ColorListviewRow(lv As ListView, RowNbr As Long, RowColor As OLE_COLOR)
'************************************************* **************************
'Purpose: Color a ListView Row
'Inputs : lv - The ListView
' RowNbr - The index of the row to be colored
' RowColor - The color to color it
'Outputs:
'************************************************* **************************
Dim itmX As ListItem
Dim lvSI As ListSubItem
Dim intIndex As Integer
On Error GoTo ErrorRoutine
Set itmX = lv.ListItems(RowNbr)
itmX.ForeColor = RowColor
For intIndex = 1 To lv.ColumnHeaders.Count - 1
Set lvSI = itmX.ListSubItems(intIndex)
lvSI.ForeColor = RowColor
Next
Set itmX = Nothing
Set lvSI = Nothing
Exit Sub
ErrorRoutine:
MsgBox Err.Description
End Sub
Private Sub lvwTOC_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim lvhti As LVHITTESTINFO
Dim lngCurrentRow As Long
lvhti.pt.x = x / Screen.TwipsPerPixelX
lvhti.pt.Y = Y / Screen.TwipsPerPixelY
lngCurrentRow = SendMessage(lvwTOC.hwnd, LVM_HITTEST, 0, lvhti) + 1
'check to see if the MouseMove has changed which row is under the mouse:
If lngCurrentRow <> m_lngPreviousRow Then 'row has changed
If ((m_lngPreviousRow > 0) And (m_lngPreviousRow <= lvwTOC.ListItems.Count)) Then
'so, we need to reset the old row's ForeColor:
ColorListviewRow lvwTOC, m_lngPreviousRow, &HFFFFC0 'light blue
If ((lngCurrentRow > 0) And (lngCurrentRow <= lvwTOC.ListItems.Count)) Then
'and set the current row's ForeColor:
ColorListviewRow lvwTOC, lngCurrentRow, &H8080FF 'light red
End If
Else 'first time through (m_lngPreviousRow = -1 in FormLoad)
If ((lngCurrentRow > 0) And (lngCurrentRow <= lvwTOC.ListItems.Count)) Then
ColorListviewRow lvwTOC, lngCurrentRow, &H8080FF 'light red
End If
End If
'and update he module level variable to indicate that the current row is now the old row:
m_lngPreviousRow = lngCurrentRow
End If
End Sub
نوشته شده توسط romina2006
http://www.ArminaCo.com
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول