VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "WinHelp" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit ' This next lot is for Html Help - the new format. 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 Const HH_DISPLAY_TOPIC = &H0 Const HH_SET_WIN_TYPE = &H4 Const HH_GET_WIN_TYPE = &H5 Const HH_GET_WIN_HANDLE = &H6 ' Display string resource ID or text in a popupwin. Const HH_DISPLAY_TEXT_POPUP = &HE ' Display mapped numeric value in dwdata Const HH_HELP_CONTEXT = &HF ' Text pop-up help, similar to WinHelp's HELP_CONTEXTMENU Const HH_TP_HELP_CONTEXTMENU = &H10 ' Text pop-up help, similar to WinHelp's HELP_WM_HELP Const HH_TP_HELP_WM_HELP = &H11 '-------------------------- End HTMLHelp 'System constants Private Const HELP_CONTEXT = &H1 Private Const HELP_QUIT = &H2 Private Const HELP_INDEX = &H3 Private Const HELP_CONTENTS = &H3& Private Const HELP_HELPONHELP = &H4 Private Const HELP_SETINDEX = &H5 Private Const HELP_SETCONTENTS = &H5& Private Const HELP_CONTEXTPOPUP = &H8& Private Const HELP_FORCEFILE = &H9& Private Const HELP_KEY = &H101 Private Const HELP_COMMAND = &H102& Private Const HELP_PARTIALKEY = &H105& Private Const HELP_MULTIKEY = &H201& Private Const HELP_SETWINPOS = &H203& Private Const HELP_FINDER = &HB 'Private class data Private HelpFile As String Private hwnd As Long 'Declaration for WinHelp API Private Declare Function WinHelpKey Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As String) As Long Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long Public Sub ShowKeyList(sKey As String) Dim RetVal As Long Dim Scratch As String Scratch = "AL(`" & sKey & "', 1, `', `')" & Chr$(0) If (hwnd <> 0) And (Len(HelpFile) <> 0) Then RetVal = WinHelpKey(hwnd, HelpFile, HELP_COMMAND, Scratch) End If End Sub Public Sub ShowContents() Dim RetVal As Long ' Removed check (hwnd <> 0) If (Len(HelpFile) <> 0) Then RetVal = HtmlHelp(hwnd, HelpFile, HH_DISPLAY_TOPIC, 0) End If End Sub Public Sub ShowPopup(lContext As Long) Dim RetVal As Long If (hwnd <> 0) And (Len(HelpFile) <> 0) Then RetVal = HtmlHelp(hwnd, HelpFile, HH_DISPLAY_TOPIC, lContext) End If End Sub Public Function SetHelpInfo(lHwnd As Long, sHelpFile As String) As Boolean If Len(Dir$(sHelpFile, vbNormal)) = 0 Then SetHelpInfo = False Exit Function End If hwnd = lHwnd HelpFile = sHelpFile SetHelpInfo = True End Function Public Sub ShowTopic(lContext As Long) Dim RetVal As Long If (hwnd <> 0) And (Len(HelpFile) <> 0) Then RetVal = HtmlHelp(hwnd, HelpFile, HH_DISPLAY_TOPIC, lContext) End If End Sub Private Sub Class_Initialize() HelpFile = vbNullString hwnd = 0 End Sub Private Sub Class_Terminate() Dim RetVal As Long ' Removed (hwnd <> 0) And If (Len(HelpFile) <> 0) Then ' RetVal = WinHelp(hwnd, HelpFile, HELP_QUIT, 0&) End If End Sub