● HTMLヘルプファイルを開く ●

ヘルプファイルは素晴らしかった。HTMLヘルプもしかり。

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

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Const HH_DISPLAY_TOC = &H1
Private Const HH_CLOSE_ALL = &H12

'-----------------------------------------------------------------------
' 関数名 : OpenHTMLHelp
' 機能   : HTMLヘルプを表示する
' 引数   : (in) HTMLHelpFile … HTMLヘルプ
' 戻り値 : HTMLヘルプウィンドウのハンドル
'           "HHCTRL.OCX" が存在しない場合は -1   エラー時は0
'-----------------------------------------------------------------------
Public Function OpenHTMLHelp(ByVal HTMLHelpFile As String) As Long
    Dim hInstance As Long

    'HTMLヘルプ呼び出しでは HHCTRL.OCX が System32 ディレクトリに存在して
    'いないといけない。ということで存在チェックを行い、存在している場合
    'HTMLヘルプを実行する
    hInstance = LoadLibrary("HHCTRL.OCX")
    If hInstance Then
        OpenHTMLHelp = HtmlHelp(GetDesktopWindow, HTMLHelpFile, _
                               HH_DISPLAY_TOC, ByVal 0&)
    Else
        OpenHTMLHelp = (-1)
    End If
    If hInstance Then Call FreeLibrary(hInstance)

End Function

ついでにHTMLヘルプを閉じるコードも書いておく。

'-----------------------------------------------------------------------
' 関数名 : CloseHTMLHelp
' 機能   : HTMLヘルプを閉じる
' 引数   : なし
' 戻り値 : なし
'-----------------------------------------------------------------------
Public Sub CloseHTMLHelp()
    Call HtmlHelp(0, vbNullChar, HH_CLOSE_ALL, ByVal 0&)
End Sub

呼び出し側は以下のような感じで。

Private Sub Command1_Click()
    Dim hHTMLHelpWindow As Long
    hHTMLHelpWindow = OpenHTMLHelp("api.chm")
End Sub

戻る