Нажатие F1 генерит сообщение
WM_HELP message
В этот момент hwnd доступно, взять его можно через
HH_GET_WIN_HANDLE command
Но для этого нужен "the name of the window type whose handle you want to return".
Это задается в hhp файле chm -проекта:
1.
2.
[WINDOWS]
MyProgaHelp=,"Table of Contents.hhc",,"Introduction_Main.htm",,,,,,0x2120,,0x3006,,,,,,,, 1
MyProgaHelp -это и есть "window type"
1 в конце это "notification ID (referred to as idNotify)" -обеспечивает генерацию
Notification Messages от окна хэлпа через сабклассинг вызывающего окна.
http://msdn.microsoft.com/en-us/library/office/aa164216(v=office.10).aspx
Итого имеем:
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.
Public Help_Created As Boolean
Public Function NewFormMeWindowProc( _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim uNMHDR As NMHDR
If IsWinVista And ThemesEnabled(Form1.hwnd) Then
Select Case Msg
Case WM_HELP ' по нажатию F1
Debug.Print "WM_HELP"
Dim hwndHelp As Long
hwndHelp = HTMLHelp(Form1.hwnd, App.Path & "\" & "proga.chm", HH_GET_WIN_HANDLE, ByVal "MyProgaHelp")
Help_Created = True
If hwndHelp <> 0 Then ApplyHelpStyle hwndHelp
Case WM_NOTIFY
CopyMemory uNMHDR, ByVal lParam, Len(uNMHDR)
Select Case uNMHDR.code
Case HHN_WINDOW_CREATE 'вызов через Help API, но стиль применять еще рано
Debug.Print "HHN_WINDOW_CREATE"
Help_Created = True
Case HHN_NAVCOMPLETE
'Debug.Print "HHN_NAVCOMPLETE"
If Help_Created Then
hwndHelp = HTMLHelp(Form1.hwnd, App.Path & "\" & "proga.chm", HH_GET_WIN_HANDLE, ByVal "MyProgaHelp")
If hwndHelp <> 0 Then ApplyHelpStyle hwndHelp
End If
Case HHN_TRACK
'Debug.Print "HHN_TRACK"
If Help_Created Then
hwndHelp = HTMLHelp(Form1.hwnd, App.Path & "\" & "proga.chm", HH_GET_WIN_HANDLE, ByVal "MyProgaHelp")
If hwndHelp <> 0 Then ApplyHelpStyle hwndHelp
End If
End Select
Case Else
End Select
End If
NewFormMeWindowProc = CallWindowProc( _
OldFormMeWindowProc, hwnd, Msg, wParam, _
lParam)
End Function
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
'при вызове Help-а через API (напр. нажали кнопку Help)
'срабатывает только почле HHN_WINDOW_CREATE
Private Sub Combo1_Click()
Dim hwndHelp As Long
hwndHelp = HTMLHelp(Me.hwnd, App.Path & "\" & "proga.chm", HH_DISPLAY_TOPIC, ByVal Combo1.Text)
If IsWinVista And ThemesEnabled(Form1.hwnd) Then
If hwndHelp <> 0 Then
If Help_Created Then
ApplyHelpStyle hwndHelp
End If
End If
End If
End Sub
Ну а стиль применяется так, делаю стандартное вистовское TreeView:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Public Sub ApplyHelpStyle(hwndHelp As Long)
Dim hwndHHChild As Long
Dim hwndTv As Long
Do
hwndHHChild = FindWindowEx(hwndHelp, hwndHHChild, "HH Child", vbNullChar)
If hwndHHChild = 0 Then Exit Do
hwndTv = FindWindowEx(hwndHHChild, 0, "SysTreeView32", vbNullChar)
If hwndTv <> 0 Then Exit Do
Loop
If hwndTv <> 0 Then
Dim lStyle As Long
SetWindowTheme hwndTv, StrPtr("explorer"), 0
'линии не нужны - не стильно,гориз. scroll не нужен
SetWindowLong hwndTv, GWL_STYLE, (GetWindowLong(hwndTv, GWL_STYLE) Or TVS_HASBUTTONS Or TVS_LINESATROOT Or TVS_NOHSCROLL) And Not TVS_HASLINES
'применяем горизонт. авто-scroll и фейдер (стрелка что вместо +/- растворится при потере фокуса формой)
lStyle = SendMessage(hwndTv, TVM_GETEXTENDEDSTYLE, 0, 0)
lStyle = lStyle Or TVS_EX_FADEINOUTEXPANDOS Or TVS_EX_AUTOHSCROLL Or TVS_EX_DOUBLEBUFFER
Call SendMessageLong(hwndTv, TVM_SETEXTENDEDSTYLE, 0, ByVal lStyle)
Help_Created = False
Debug.Print "Style applied"
End If
End Sub
Т.е. либо
F1 -> WM_HELP -> hwndHelp
Либо
hwndHelp=HTMLHelp(HH_DISPLAY_TOPIC) - HHN_WINDOW_CREATE срабатывает раньше
Частный случай - когда Context (дерево Navigation Pane) в справке скрыт на момент открытия, для этого и нужны махинации с HHN_NAVCOMPLETE, HHN_TRACK и Help_Created - не 100% грамотно но все же.
Думаю как сделать чтобы
Navigation Pane всегда отображалась при открытии .chm -независимо от того как обстояло дело при последнем закрытии файла .chm.
С иконками бы в дереве еще разобраться, "обновить" бы их.
