ヘルプファイルは素晴らしかった。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
'----------------------------------------------------------------------- ' 関数名 : 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 |