WinHelp.cls #1

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