chm

[Roman Yuakovlev]

Можно ли связать кнопку Help в InputBox с CHM-файлом.

Сабклассеры и прочие колбейкеры, ау! ;)

... все равно его не брошу потому что жаба давит...

[A. Skrobov]

Wed Jul 14 2004 19:18, Roman Yuakovlev wrote to All:

RY> Можно ли связать кнопку Help в InputBox с CHM-файлом.
Ага ;-)

RY> Сабклассеры и прочие колбейкеры, ау! ;)
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal
nIDEvent As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Private Declare Function HTMLHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal
hWndMain As Long, ByVal lpszHelp As String, ByVal uCommand As Long, ByVal
ptrTopic As Long) As Long
Private Const GWL_WNDPROC As Long = -4&
Private Const WM_COMMAND As Long = &H111&
Private Const WM_HELP As Long = &H53&
Private Const HH_HELP_CONTEXT As Long = &HF&
Private m_Title As String, m_HelpFile As String, m_Context As Long
Private OldWindowProc As Long

Private Sub TimerProc(ByVal hWnd0 As Long, ByVal uMsg As Long, ByVal idEvent
As Long, ByVal dwTime As Long)
Dim hWnd As Long
KillTimer hWnd0, idEvent
hWnd = FindWindow("#32770", m_Title)
If hWnd = 0 Then Exit Sub 'bad luck...
OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam
As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_COMMAND:
If wParam = &H1326 Then InvokeHelp (hWnd): Exit Function
Case WM_HELP:
InvokeHelp (hWnd)
WndProc = 1
Exit Function
End Select
WndProc = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
End Function

Private Sub InvokeHelp(ByVal hWnd As Long)
HTMLHelp hWnd, m_HelpFile, HH_HELP_CONTEXT, m_Context
End Sub

Private Function InputBoxEx(ByVal Prompt As String, Optional ByVal Title,
Optional ByVal Default As String, Optional ByVal XPos, Optional ByVal YPos,
Optional ByVal HelpFile As String, Optional ByVal Context As Long) As String
SetTimer 0, 0, 10, AddressOf TimerProc
m_Title = Title
m_HelpFile = HelpFile
m_Context = Context
InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
End Function

Sub Main()
MsgBox InputBoxEx("Push F1 for help", "Title", "Default", , , "MSWNSK98.chm",
&H5303F), vbExclamation, "You typed:"
End Sub

[Roman Yuakovlev]

RY>> Можно ли связать кнопку Help в InputBox с CHM-файлом.

AS> Ага ;-)
Очень извиняюсь, но уже не нужно. Юзеры - народ привередливый, им пустое место
не нужно. ;) Поэтому сделал свой компактный вариант инпутбокса - дешево и
сердито.

ps. Артем, ты что, десктоп-менеджер делаешь? Если да, и разработка у тебя не
сторонне-комерческая, плиз, отклинись в емейле? Сильно не напрягет. ;)