问Microsoft 2007数据库应用程序HTML帮助打开多个chm文件实例

EN

Option Compare Database
Option Explicit

'******************************************************************************
'----- Modul - definition for HTMLHelp - (c) Ulrich Kulle, www.help-info.de
'----- 2014-08-26 Version 0.1.9000
'******************************************************************************

Declare Function IsWindow Lib "user32.dll" (ByVal hWnd As Long) As Long

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 HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
                (ByVal hwndCaller As Long, ByVal pszFile As String, _
                ByVal uCommand As Long, ByVal dwData As Long) As Long

Declare Function HTMLHelpTopic Lib "hhctrl.ocx" Alias "HtmlHelpA" _
         (ByVal hwndCaller As Long, ByVal pszFile As String, _
         ByVal uCommand As Long, ByVal dwData As String) As Long

Private Declare Function HtmlHelpSearch Lib "hhctrl.ocx" Alias "HtmlHelpA" _
        (ByVal hwndCaller As Long, ByVal pszFile As String, _
        ByVal uCommand As Long, dwData As HH_FTS_QUERY) As Long

'--- to keep the handle of the HH windows when calling help by API --------
Public HHwinHwnd As Long

'--- some constants used by the API ---------------------------------------
Public Const HH_DISPLAY_TOPIC = &H0     ' select last opened tab, [display a specified topic]
Public Const HH_DISPLAY_TOC = &H1       ' select contents tab, [display a specified topic]
Public Const HH_DISPLAY_INDEX = &H2     ' select index tab and searches for a keyword
Public Const HH_DISPLAY_SEARCH = &H3    ' select search tab and perform a search

Public Const HH_HELP_CONTEXT = &HF      ' display mapped numeric value in dwData

Public Const HH_CLOSE_ALL = &H12

Public Type HH_FTS_QUERY                ' UDT for accessing the Search tab
  cbStruct          As Long             ' Sizeof structure in bytes.
  fUniCodeStrings   As Long             ' TRUE if all strings are unicode.
  pszSearchQuery    As String           ' String containing the search query.
  iProximity        As Long             ' Word proximity.
  fStemmedSearch    As Long             ' TRUE for StemmedSearch only.
  fTitleOnly        As Long             ' TRUE for Title search only.
  fExecute          As Long             ' TRUE to initiate the search.
  pszWindow         As String           ' Window to display in
End Type

Public Function HFile(ByVal i_HFile As Integer) As String
'----- Set the string variable to include the application path of helpfile
  Select Case i_HFile

  '//--- default help file
  Case 1
    HFile = CurrentProject.Path & "\CHM-example.chm"
  Case 2
'----- Place other Help file paths in successive case statements
    HFile = CurrentProject.Path & "\CHM-example.chm"
  End Select
End Function

Public Sub OpenHelp(strHelpFile As String, lngID As Long)
    Dim hWnd As Long
    Dim strHelpFile As String
    strHelpFile = CurrentProject.Path & "\CHM-example.chm"
    hWnd = HtmlHelp(Application.hWndAccessApp, strHelpFile, HH_DISPLAY_TOC, lngID)
End Sub

Public Function CallHelp()
'//--- TEST invoking help with different methods ----------------------------------
    'OpenHelp strHelpFile, 20010
    'ShowContents 1
    'ShowIndex 1
    'ShowSearch 1
    If Screen.ActiveForm.Name = "Coordinates-Form-1" Then
        MsgBox Screen.ActiveForm.Name
        ShowTopicID 1, 10010
    ElseIf Screen.ActiveForm.Name = "Coordinates-Form-2" Then
        MsgBox Screen.ActiveForm.Name
        ShowTopicID 1, 20010
    Else
        ShowContents 1
    End If
End Function

Public Sub ShowContents(ByVal intHelpFile As Integer)
    HHwinHwnd = HtmlHelp(Application.hWndAccessApp, HFile(intHelpFile), HH_DISPLAY_TOC, 0)
End Sub

Public Sub ShowIndex(ByVal intHelpFile As Integer)
    HHwinHwnd = HtmlHelp(Application.hWndAccessApp, HFile(intHelpFile), HH_DISPLAY_INDEX, 0)
End Sub

Public Sub ShowTopic(ByVal intHelpFile As Integer, strTopic As String)
    HHwinHwnd = HTMLHelpTopic(Application.hWndAccessApp, HFile(intHelpFile), HH_DISPLAY_TOPIC, strTopic)
End Sub

Public Sub ShowTopicID(ByVal intHelpFile As Integer, IdTopic As Long)
    HHwinHwnd = HtmlHelp(Application.hWndAccessApp, HFile(intHelpFile), HH_HELP_CONTEXT, IdTopic)
End Sub

'------------------------------------------------------------------------------
'----- display the search tab
'----- bug: start searching with a string dosn't work
'------------------------------------------------------------------------------
Public Sub ShowSearch(ByVal intHelpFile As Integer)
Dim searchIt As HH_FTS_QUERY
  With searchIt
    .cbStruct = Len(searchIt)
    .fUniCodeStrings = 1&
    .pszSearchQuery = "foobar"
    .iProximity = 0&
    .fStemmedSearch = 0&
    .fTitleOnly = 1&
    .fExecute = 1&
    .pszWindow = ""
  End With
  Call HtmlHelpSearch(0&, HFile(intHelpFile), HH_DISPLAY_SEARCH, searchIt)
End Sub