تغییر رنگ فونت سطر در ListVeiw

[romina2006]

با سلام

چه جوری میشه خاصیت ForeColor یک سطر در ListVeiw رو وقتیکه موس بر روی اون سطر قرار داره رو تغییر داد که با بقیه سطور فرق داشته باشه؟

[romina2006]

خودم پیداش کردم


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

[علیرضا5]

لطفا جوابتون رو اول در یک TXT کپی کنید بعد از اونجا کپی کنید داخل سایت که استایلهاش حذف بشه

[vbhamed]

خودم پیداش کردم


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




اینهمه کد برای یک کار ساده ارزش نداره اونم با تابع SendMessage
توصیه میکنم حتما از vsFlexGrid استفاده کنید

[romina2006]

برای vsFlexGrid این کد رو نوشتم کار میکنه ولی وقتیکه روی سطر آخر کلیک میکنم خطا Invalid property array index رو میده.چیکار باید کرد ؟



If VSFlexGrid1.MouseRow = 0 Or VSFlexGrid1.MouseRow = -1 Then Exit Sub
VSFlexGrid1.Cell(flexcpBackColor, VSFlexGrid1.MouseRow, 1, VSFlexGrid1.MouseRow, VSFlexGrid1.Cols - 1) = &H80C0FF
For I = 1 To VSFlexGrid1.Row
If I = VSFlexGrid1.MouseRow Then I = I + 1
VSFlexGrid1.Cell(flexcpBackColor, I, 1, I, VSFlexGrid1.Cols - 1) = &HC0FFFF
Next I

[www.pc3enter.tk]

یک دونه null اضافی به انتهای لیست اضافه کن

[romina2006]

کدش رو تصحیح کردم :



If VSFlexGrid1.MouseRow = 0 Or VSFlexGrid1.MouseRow = -1 Then Exit Sub
VSFlexGrid1.Cell(flexcpBackColor, VSFlexGrid1.MouseRow, 1, VSFlexGrid1.MouseRow, VSFlexGrid1.Cols - 1) = &H80C0FF
For I = 1 To VSFlexGrid1.Rows - 2
If I = VSFlexGrid1.MouseRow Then I = I + 1
VSFlexGrid1.Cell(flexcpBackColor, I, 1, I, VSFlexGrid1.Cols - 1) = &HC0FFFF
Next I