form1.frm

怎样在VB程序中使用帮助文件

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3756
   ClientLeft      =   48
   ClientTop       =   432
   ClientWidth     =   5280
   LinkTopic       =   "Form1"
   ScaleHeight     =   3756
   ScaleWidth      =   5280
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   612
      Left            =   1080
      TabIndex        =   0
      Top             =   720
      Width           =   1092
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_HelpServices As VsHelpServices.VsHelpServices
Private m_lcid  As Long
Private m_sHelpFile As String


'------------------------------------------------------------
' Purpose:      set the filename of the help topic
' Param sName:  filename of help topic
'------------------------------------------------------------
Public Sub setHelpFile(ByVal sName As String)
'------------------------------------------------------------
    m_sHelpFile = sName
End Sub

'------------------------------------------------------------
' Public Sub DisplayTopic(ByVal toc As Long)
' Purpose:      displays the html topic identified by toc. Assumes helpfile has already been set
' Param sHelpFile: chm file you are looking up
' Param toc:    topic id to be displayed
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub DisplayTopic(ByVal toc As Long)
'------------------------------------------------------------
On Error GoTo errorHandle

    Debug.Assert Len(m_sHelpFile) > 0
    
    If Not initialiseHelp() Then Exit Sub
        
    m_HelpServices.DisplayTopicFromIdentifier m_sHelpFile, toc, VHS_Localize
        
errorHandle:
    ' html help throws up its own error if it can't display help
End Sub


'------------------------------------------------------------
' initialse the HTML help system
'------------------------------------------------------------
Private Function initialiseHelp() As Boolean
On Error GoTo errorHandle
    Dim helpInit As IVsHelpInit
    
    If m_HelpServices Is Nothing Then
        Set m_HelpServices = New VsHelpServices.VsHelpServices
        Set helpInit = m_HelpServices
        helpInit.LoadUIResources m_lcid
        DoEvents
    End If
    
    initialiseHelp = True

errorHandle:
    If Err <> 0 Then
        initialiseHelp = False
        MsgBox Err.Description
    End If
End Function

'------------------------------------------------------------
' Public Sub ReleaseHelp
' Purpose:      cleans up m_HelpServices
'------------------------------------------------------------
Public Sub ReleaseHelp()
'------------------------------------------------------------
    Set m_HelpServices = Nothing
End Sub

'------------------------------------------------------------
' Public Sub KeywordSearch(sKey as string, lcid as long)
' Purpose:      performs a keyword search on the entire (installed) msdn.
' Param sKey:   keyword to be searched for
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub KeywordSearch(ByVal sKey As String)
'------------------------------------------------------------
On Error GoTo errorHandle

    If Not initialiseHelp() Then Exit Sub
    
    m_HelpServices.KeywordSearch sKey, 0, 0
    
errorHandle:
    ' html help throws up its own error if it can't display help
    
End Sub

Public Function GetVbIdeLocale() As Long
'------------------------------------------------------------
    Dim hInstance   As Long
    Dim sLocale     As String
    Dim rc          As Long
    Const LOCALERESID = 2001
'------------------------------------------------------------
    hInstance = LoadLibraryEx("VB6IDE.DLL", 0&, LOAD_LIBRARY_AS_DATAFILE)
    If (hInstance <> 0) Then
        sLocale = String$(20, vbNullChar)
        rc = LoadStringA(hInstance, LOCALERESID, sLocale, Len(sLocale))
        If (rc > 0) Then
            GetVbIdeLocale = Val("&H" & sLocale)
        End If
        FreeLibrary hInstance
    End If
'------------------------------------------------------------
End Function

'------------------------------------------------------------
' Purpose:      set the locale ID for HTML help resources
' Param lcid:   Locale ID in which it is to be displayed
'------------------------------------------------------------
Public Sub setHelpLocaleID(ByVal LCID As Long)
'------------------------------------------------------------
    m_lcid = LCID
End Sub



Private Sub Command1_Click()
KeywordSearch "hu"
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 1002
  End If
End Sub

Private Sub Form_Load()
 App.HelpFile = "d:\vb帮助文件的使用\help\QCHHELP.chm"
 setHelpFile App.HelpFile
 
  'App.HelpFile = "vb98.chm"
  'setHelpFile App.HelpFile            ' 为 HTML 帮助引擎设置 HTML 帮助文件名称
  'setHelpLocaleID GetVbIdeLocale       ' 获得 HTML 帮助引擎的 VBIDE 的地区

End Sub

Private Sub Form_Unload(Cancel As Integer)
    ReleaseHelp
End Sub