1 en algun modulo publico
Public m_HtmlHelp As cHtmlHelp
Public Sub Help(frm As Form)
Dim sHelpFile As String
cHelpFile = App.Path & "\integral.chm"
sHelpFile = cHelpFile
App.HelpFile = sHelpFile
Set m_HtmlHelp = New cHtmlHelp
With m_HtmlHelp
.hwnd = frm.hwnd
.HelpFile = sHelpFile
End With
End Sub
2 en cualquier formulario, boton o menu
Sub Ayuda()
Call Help(Me)
Call m_HtmlHelp.DisplayTopic("ventas.htm")
End Sub
3 creo mi modulo de clase cHtmlHelp
Option Explicit
#Const ES_DEBUG = 0
Private Type HH_IDPAIR
dwControlId As Long
dwTopicId As Long
End Type
Private ids(0 To 1) As HH_IDPAIR
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long
Public hwnd As Long
Public HelpFile As String
Private Enum HH_COMMAND
HH_Display_Topic = &H0
HH_HELP_FINDER = &H0
HH_DISPLAY_TOC = &H1
HH_DISPLAY_INDEX = &H2
HH_DISPLAY_SEARCH = &H3
HH_SET_WIN_TYPE = &H4
HH_GET_WIN_TYPE = &H5
HH_GET_WIN_HANDLE = &H6
HH_GET_INFO_TYPES = &H7
HH_SET_INFO_TYPES = &H8
HH_SYNC = &H9
HH_ADD_NAV_UI = &HA
HH_ADD_BUTTON = &HB
HH_GETBROWSER_APP = &HC
HH_KEYWORD_LOOKUP = &HD
HH_DISPLAY_TEXT_POPUP = &HE
HH_Help_Context = &HF
HH_TP_HELP_CONTEXTMENU
HH_TP_HELP_WM_HELP = &H11
HH_CLOSE_ALL = &H12
HH_ALINK_LOOKUP = &H13
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type PointAPI
X As Long
Y As Long
End Type
Private Type tagHH_POPUP
cbStruct As Long
hinst As Long
idString As Long
pszText As String
pt As PointAPI
clrForeground As Long
clrBackground As Long
rcMargins As RECT
pszFont As String
End Type
Private Type tagHH_FTS_QUERY
cbStruct As Long
fUniCodeStrings As Long
pszSearchQuery As String
iProximity As Long
fStemmedSearch As Long
fTitleOnly As Long
fExecute As Long
pszWindow As String
End Type
Private Declare Function HtmlHelp Lib "HHCtrl.ocx" Alias "HtmlHelpA" _
(ByVal hWndCaller As Long, ByVal pszFile As String, _
ByVal uCommand As HH_COMMAND, dwData As Any) As Long
Public Function DisplayContext(Optional ByVal TopicNum As Long = 0&) As Long
Dim sHelpFile As String
sHelpFile = SoloCHM
DisplayContext = HtmlHelp(hwnd, sHelpFile, HH_Help_Context, ByVal TopicNum)
#If ES_DEBUG Then
Debug.Print "DisplayContext= " & DisplayContext
#End If
End Function
Public Function DisplayTopic(Optional ByVal TopicName As String = "") As Long
Dim sHelpFile As String
sHelpFile = SoloCHM
If Len(TopicName) = 0 Then
DisplayTopic = HtmlHelp(hwnd, sHelpFile, HH_Display_Topic, ByVal 0&)
Else
DisplayTopic = HtmlHelp(hwnd, sHelpFile, HH_Display_Topic, ByVal TopicName)
End If
#If ES_DEBUG Then
Debug.Print "DisplayTopic= " & DisplayTopic
#End If
End Function
Public Function PopUp(ByVal Text As String) As Long
Dim HH_POPUP As tagHH_POPUP
Dim elForm As Form
On Local Error Resume Next
Set elForm = Screen.ActiveForm
With HH_POPUP
.cbStruct = Len(HH_POPUP)
.clrBackground = -1
.clrForeground = -1
.pszFont = "Verdana,8"
.pszText = Text
.pt.X = (elForm.Left + 360) \ Screen.TwipsPerPixelX
.pt.Y = (elForm.Top + (elForm.Height \ 2) + 240) \ Screen.TwipsPerPixelY
.rcMargins.Bottom = -1
.rcMargins.Left = -1
.rcMargins.Right = -1
.rcMargins.Top = -1
End With
PopUp = HtmlHelp(hwnd, HelpFile, HH_DISPLAY_TEXT_POPUP, HH_POPUP)
#If ES_DEBUG Then
Debug.Print "PopUp= " & PopUp
#End If
Err = 0
End Function
Public Function DisplaySearch() As Long
Dim sHelpFile As String
Dim HH_FTS_QUERY As tagHH_FTS_QUERY
With HH_FTS_QUERY
.cbStruct = Len(HH_FTS_QUERY)
.fStemmedSearch = 0&
.fTitleOnly = 0&
.fUniCodeStrings = 0&
.iProximity = 0&
.pszSearchQuery = ""
.pszWindow = ""
.fExecute = 1&
End With
sHelpFile = SoloCHM
DisplaySearch = HtmlHelp(hwnd, sHelpFile, HH_DISPLAY_SEARCH, HH_FTS_QUERY)
#If ES_DEBUG Then
Debug.Print "DisplaySearch= " & DisplaySearch
#End If
End Function
Public Function DisplayTOC() As Long
'Muestra la tabla de contenidos (TOC)
Dim sHelpFile As String
sHelpFile = SoloCHM
DisplayTOC = HtmlHelp(hwnd, sHelpFile, HH_DISPLAY_TOC, ByVal 0&)
#If ES_DEBUG Then
Debug.Print "DiplayToc= " & DisplayTOC
#End If
End Function
Public Function DisplayIndex(Optional ByVal sKeyWord As String = "") As Long
Dim sHelpFile As String
sHelpFile = SoloCHM
If Len(sKeyWord) = 0 Then
DisplayIndex = HtmlHelp(hwnd, sHelpFile, HH_DISPLAY_INDEX, ByVal 0&)
Else
DisplayIndex = HtmlHelp(hwnd, sHelpFile, HH_DISPLAY_INDEX, ByVal sKeyWord)
End If
#If ES_DEBUG Then
Debug.Print "DisplayIndex= " & DisplayIndex
#End If
End Function
Private Function SoloCHM() As String
Dim i As Long
Dim sHelpFile As String
sHelpFile = HelpFile
i = InStr(sHelpFile, "::/")
If i Then
sHelpFile = Trim$(Left$(sHelpFile, i - 1))
End If
SoloCHM = sHelpFile
End Function
Public Function HelpContextPop(Optional ByVal elControl As Control) As Long
Dim vControl As Control
On Local Error Resume Next
If elControl Is Nothing Then
Set vControl = Screen.ActiveControl
Else
Set vControl = elControl
End If
ids(0).dwTopicId = CLng(vControl.HelpContextID)
ids(0).dwControlId = GetDlgCtrlID(vControl.hwnd)
ids(1).dwControlId = 0
ids(1).dwTopicId = 0
If Err = 0 Then
HelpContextPop = HtmlHelp(vControl.hwnd, HelpFile, HH_TP_HELP_WM_HELP, ids(0))
End If
Err = 0
End Function
Public Function HelpContext(Optional ByVal elControl As Control, _
Optional ByVal laVentana As String = "") As Long
Dim vControl As Control
Dim TopicNum As Long
Dim sHelpFile As String
On Local Error Resume Next
If elControl Is Nothing Then
Set vControl = Screen.ActiveControl
Else
Set vControl = elControl
End If
TopicNum = CLng(vControl.HelpContextID)
If Err = 0 Then
sHelpFile = SoloCHM
If Len(laVentana) Then
sHelpFile = sHelpFile & " >" & laVentana
End If
HelpContext = HtmlHelp(hwnd, sHelpFile, HH_Help_Context, ByVal TopicNum)
End If
Err = 0
End Function
