А все-таки я это сделал.
Надо понять состояние, когда мышь пришла в SysLink и что несколько сложнее что она оттуда ушла. Состояние что мышь в SysLink определяем константой State_HotTrack
1. Сабклассим SysLink и ловим первый WM_MOUSEMOVE
В нем:
1) фиксируем состояние "мышь в SysLink" (State_HotTrack = True)
2) заказываем событие WM_MOUSELEAVE (само не вызовется) через вызов TrackMouseEvent+TME_LEAVE
3) меняем состояние SysLink на LIS_HOTTRACK (ссылка подсвечивается), либо на любое другое (например можно использовать LIS_FOCUSED) -тогда цвет ссылки не меняется
4) Пункт 3 что существенно
вызывает NM_CUSTOMDRAW , которое следит за "подчеркиванием", поэтому хоть что-то (пусть незаметное) там надо вызвать.
2. При получении WM_MOUSELEAVE (оно гарантированно вызовется в силу 1.2)
1) фиксируем состояние "мышь ушла" (State_HotTrack = False)
2) снимаем флаг LIS_HOTTRACK (убираем подсвечивание), либо другое установленный (например LIS_FOCUSED если цвет ссылки не менялся)
3)Пункт 2 что опять существенно
вызывает NM_CUSTOMDRAW , которое следит за "подчеркиванием".
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
Public Function NewMyLinkWindowProc( _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tLitem As tagLITEM
Select Case Msg
Case WM_MOUSEMOVE
If State_HotTrack = False Then
State_HotTrack = True
TrackControlLeave Form1.hLinkTest
SetLinkHottrack Form1.hLinkTest, IIf(ThemesEnabled(Form1.hLinkTest), LIS_HOTTRACK, LIS_FOCUSED), True
End If
Case WM_MOUSELEAVE
State_HotTrack = False
SetLinkHottrack Form1.hLinkTest, IIf(ThemesEnabled(Form1.hLinkTest), LIS_HOTTRACK, LIS_FOCUSED), False
Case Else
End Select
NewMyLinkWindowProc = CallWindowProc( _
OldMyLinkWindowProc, hwnd, Msg, wParam, _
lParam)
End Function
Private Sub TrackControlLeave(hwnd As Long)
Dim ET As TRACKMOUSEEVENTTYPE
'initialize structure
With ET
.cbSize = Len(ET)
.hwndTrack = hwnd
.dwFlags = TME_LEAVE
End With
TrackMouseEvent ET
End Sub
Private Sub SetLinkHottrack(hSysLink As Long, LIS_CONST As LIS_constants, track As Boolean)
Dim tLitem As tagLITEM
With tLitem
.iLink = 0
.mask = LIF_ITEMINDEX Or LIF_STATE
.state = IIf(track, LIS_CONST, 0)
.stateMask = LIS_CONST
End With
SendMessage hSysLink, LM_SETITEM, 0, tLitem
End Sub
Public Enum LIS_constants
LIS_FOCUSED = &H1
LIS_ENABLED = &H2
LIS_VISITED = &H4
LIS_HOTTRACK = &H8
LIS_DEFAULTCOLORS = &H10
End Enum
Ну, а задача CustomDraw -
вернуть "шрифт с подчеркиванием" когда State_HotTrack = True
либо
вернуть "шрифт без подчеркивания" когда State_HotTrack = False
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Case NM_CUSTOMDRAW
If uNMHDR.hwndFrom = Form1.hLinkTest Then
Static lvcd As NMCUSTOMDRAW
CopyMemory lvcd, ByVal lParam, Len(lvcd) ' every structs' member is a Long
Select Case lvcd.dwDrawStage
' ====================================================
Case CDDS_PREPAINT
NewFormMeWindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
' ====================================================
Case CDDS_ITEMPREPAINT
If State_HotTrack Then
SelectObject lvcd.hdc, fnt_Underlined.hFont
Else
SelectObject lvcd.hdc, fnt_Normal.hFont
End If
NewFormMeWindowProc = CDRF_NEWFONT
Exit Function
Case Else
End Select
End If
Case Else
End Select
Но - это работает только на Вистообразных.
На XP не поддерживается LIS_HOTTRACK и ни одно из LIS_ не вызывает CustomDraw, т.е. нету ввода для управления подчеркиванием.
Еще на классике в Vista лучше использовать LIS_FOCUSED -т.е. цвет не меняется, а CustomDraw генерируется - цвет выделения там фиговый какой-то.
