123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297 |
- {
- This Delphi component is part of TIGCC IDE.
- Copyright (C) 2000-2004 Sebastian Reichelt
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- }
- unit HTMLHelpUnit;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ShellAPI, Menus;
- const
- HH_DISPLAY_TOPIC = $0000;
- HH_HELP_FINDER = $0000; // WinHelp equivalent
- HH_DISPLAY_TOC = $0001;
- HH_DISPLAY_INDEX = $0002;
- HH_DISPLAY_SEARCH = $0003;
- HH_SET_WIN_TYPE = $0004;
- HH_GET_WIN_TYPE = $0005;
- HH_GET_WIN_HANDLE = $0006;
- HH_ENUM_INFO_TYPE = $0007; // Get Info type name, call repeatedly to enumerate, -1 at end
- HH_SET_INFO_TYPE = $0008; // Add Info type to filter.
- HH_SYNC = $0009;
- HH_RESERVED1 = $000A;
- HH_RESERVED2 = $000B;
- HH_RESERVED3 = $000C;
- HH_KEYWORD_LOOKUP = $000D;
- HH_DISPLAY_TEXT_POPUP = $000E; // display string resource id or text in a popup window
- HH_HELP_CONTEXT = $000F; // display mapped numeric value in dwData
- HH_TP_HELP_CONTEXTMENU = $0010; // text popup help, same as WinHelp HELP_CONTEXTMENU
- HH_TP_HELP_WM_HELP = $0011; // text popup help, same as WinHelp HELP_WM_HELP
- HH_CLOSE_ALL = $0012; // close all windows opened directly or indirectly by the caller
- HH_ALINK_LOOKUP = $0013; // ALink version of HH_KEYWORD_LOOKUP
- HH_GET_LAST_ERROR = $0014; // not currently implemented // See HHERROR.h
- HH_ENUM_CATEGORY = $0015; // Get category name, call repeatedly to enumerate, -1 at end
- HH_ENUM_CATEGORY_IT = $0016; // Get category info type members, call repeatedly to enumerate, -1 at end
- HH_RESET_IT_FILTER = $0017; // Clear the info type filter of all info types.
- HH_SET_INCLUSIVE_FILTER = $0018; // set inclusive filtering method for untyped topics to be included in display
- HH_SET_EXCLUSIVE_FILTER = $0019; // set exclusive filtering method for untyped topics to be excluded from display
- HH_INITIALIZE = $001C; // Initializes the help system.
- HH_UNINITIALIZE = $001D; // Uninitializes the help system.
- HH_PRETRANSLATEMESSAGE = $00FD; // Pumps messages. (NULL, NULL, MSG*).
- HH_SET_GLOBAL_PROPERTY = $00FC; // Set a global property. (NULL, NULL, HH_GPROP)
- type
- DWordPtr = DWord;
- THHAKLink = packed record
- cbStruct: Integer; // Size of this structure
- fReserved: Bool; // Must be FALSE (really!)
- pszKeywords: LPCTStr; // Semi-colon separated keywords
- pszUrl: LPCTStr; // URL to jump to if no keywords found (may be NULL)
- pszMsgText: LPCTStr; // Message text to display in MessageBox if pszUrl is NULL and no keyword match
- pszMsgTitle: LPCTStr; // Message title to display in MessageBox if pszUrl is NULL and no keyword match
- pszWindow: LPCTStr; // Window to display URL in
- fIndexOnFail: Bool; // Displays index if keyword lookup fails.
- end;
- HH_AKLINK = THHAKLink;
- tagHH_AKLINK = HH_AKLINK;
- PHHAKLink = ^THHAKLink;
- THHFTSQuery = record
- cbStruct: Integer; // Size of structure in bytes.
- fUniCodeStrings: Bool; // TRUE if all strings are unicode.
- pszSearchQuery: LPCTStr; // String containing the search query.
- iProximity: LongInt; // Word proximity.
- fStemmedSearch: Bool; // TRUE for StemmedSearch only.
- TitleOnly: Bool; // TRUE for Title search only.
- fExecute: Bool; // TRUE to initiate the search.
- pszWindow: LPCTStr; // Window to display in
- end;
- HH_FTS_QUERY = THHFTSQuery;
- tagHH_FTS_QUERY = HH_FTS_QUERY;
- THtmlHelpAProc = function(hwndCaller: HWnd; pszFile: PAnsiChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
- THtmlHelpWProc = function(hwndCaller: HWnd; pszFile: PWideChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
- THtmlHelpProc = function(hwndCaller: HWnd; pszFile: PChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
- var
- HtmlHelpA: THtmlHelpAProc;
- HtmlHelpW: THtmlHelpWProc;
- HtmlHelp: THtmlHelpProc;
- resourcestring
- SHTMLHelpNotInstalled = 'The HTML Help Viewer is not installed. Download it at www.microsoft.com.';
- SHTMLHelpFileNotFound = 'The help file could not be found.';
- type
- EHTMLHelp = class(Exception);
- EHTMLHelpNotInstalled = class(EHTMLHelp);
- EHTMLHelpFileNotFound = class(EHTMLHelp);
- THTMLHelp = class(TComponent)
- private
- FWindowHandle: HWnd;
- FCookie: DWord;
- FWindowType: string;
- FFileName: string;
- FCurrentTopic: string;
- FMaximizeOnShow: Boolean;
- procedure WndProc(var Msg: TMessage);
- function GetFileString: string;
- protected
- property CurrentTopic: string read FCurrentTopic write FCurrentTopic;
- property FileString: string read GetFileString;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function SendMessage(pszFile: PChar; uCommand: UInt; dwData: DWordPtr): HWnd;
- function Display: Boolean;
- function DisplayTopic(const Topic: string): Boolean;
- function KeywordLookup(const Keyword: string): Boolean;
- function KeywordLookupEx(const Link: THHAKLink): Boolean;
- function DisplayContentsTab: Boolean;
- function DisplayIndexTab: Boolean;
- function DisplaySearchTab: Boolean;
- procedure CloseAllWindows;
- published
- property FileName: string read FFileName write FFileName;
- property WindowType: string read FWindowType write FWindowType;
- property MaximizeOnShow: Boolean read FMaximizeOnShow write FMaximizeOnShow;
- end;
- procedure Register;
- const
- hhctrl = 'hhctrl.ocx';
- implementation
- procedure Register;
- begin
- RegisterComponents('Help', [THTMLHelp]);
- end;
- { THTMLHelp }
- procedure THTMLHelp.CloseAllWindows;
- begin
- SendMessage (nil, HH_CLOSE_ALL, 0);
- end;
- constructor THTMLHelp.Create;
- begin
- inherited;
- if Assigned (HtmlHelp) then begin
- FWindowHandle := AllocateHWnd (WndProc);
- HtmlHelp (0, nil, HH_INITIALIZE, DWordPtr (@FCookie));
- end;
- end;
- destructor THTMLHelp.Destroy;
- begin
- if Assigned (HtmlHelp) then begin
- CloseAllWindows;
- HtmlHelp (0, nil, HH_UNINITIALIZE, DWordPtr (FCookie));
- DeallocateHWnd (FWindowHandle);
- end;
- inherited;
- end;
- function THTMLHelp.Display: Boolean;
- begin
- Result := DisplayTopic ('');
- end;
- function THTMLHelp.DisplayContentsTab: Boolean;
- begin
- Display;
- Result := SendMessage (PChar (FileString), HH_DISPLAY_TOC, 0) <> 0;
- end;
- function THTMLHelp.DisplayIndexTab: Boolean;
- begin
- Display;
- Result := SendMessage (PChar (FileString), HH_DISPLAY_INDEX, 0) <> 0;
- end;
- function THTMLHelp.DisplaySearchTab: Boolean;
- var
- Query: THHFTSQuery;
- begin
- Display;
- with Query do begin
- cbStruct := SizeOf (Query);
- fUniCodeStrings := False;
- pszSearchQuery := '';
- iProximity := 0;
- fStemmedSearch := False;
- TitleOnly := False;
- fExecute := False;
- pszWindow := PChar (WindowType);
- end;
- Result := SendMessage (PChar (FileString), HH_DISPLAY_SEARCH, DWordPtr (@Query)) <> 0;
- end;
- function THTMLHelp.DisplayTopic(const Topic: string): Boolean;
- begin
- CurrentTopic := Topic;
- Result := SendMessage (PChar (FileString), HH_DISPLAY_TOPIC, 0) <> 0;
- end;
- function THTMLHelp.GetFileString: string;
- begin
- if FileName = '' then
- Result := ''
- else begin
- Result := FileName;
- if CurrentTopic <> '' then
- Result := Result + '::/' + CurrentTopic;
- if WindowType <> '' then
- Result := Result + '>' + WindowType;
- end;
- end;
- function THTMLHelp.KeywordLookup(const Keyword: string): Boolean;
- var
- Link: THHAKLink;
- begin
- if Length (Keyword) > 0 then begin
- FillChar (Link, SizeOf (Link), 0);
- with Link do begin
- cbStruct := SizeOf (Link);
- pszKeywords := PChar (Keyword);
- fIndexOnFail := True;
- end;
- Result := KeywordLookupEx (Link);
- end else
- Result := False;
- end;
- function THTMLHelp.KeywordLookupEx(const Link: THHAKLink): Boolean;
- begin
- Result := SendMessage (PChar (FileName), HH_KEYWORD_LOOKUP, DWord (@Link)) <> 0;
- end;
- function THTMLHelp.SendMessage(pszFile: PChar; uCommand: UInt;
- dwData: DWordPtr): HWnd;
- begin
- if Assigned (pszFile) and (pszFile <> '') and (not FileExists (FileName)) then
- raise EHTMLHelpFileNotFound.Create (SHTMLHelpFileNotFound);
- if Assigned (HtmlHelp) then
- Result := HtmlHelp (FWindowHandle, pszFile, uCommand, dwData)
- else
- raise EHTMLHelpNotInstalled.Create (SHTMLHelpNotInstalled);
- if (Result <> 0) and MaximizeOnShow then
- ShowWindow (Result, SW_MAXIMIZE);
- end;
- procedure THTMLHelp.WndProc(var Msg: TMessage);
- begin
- if Assigned (HtmlHelp) then
- try
- if HtmlHelp (0, nil, HH_PRETRANSLATEMESSAGE, DWordPtr (@Msg)) = 0 then
- with Msg do
- Result := DefWindowProc (FWindowHandle, Msg, wParam, lParam);
- except
- Application.HandleException (Self);
- end
- else
- with Msg do
- Result := DefWindowProc (FWindowHandle, Msg, wParam, lParam);
- end;
- { HTML Help Initialization }
- var
- LibHandle: THandle;
- initialization
- LibHandle := LoadLibrary (hhctrl);
- if LibHandle <> 0 then begin
- @HtmlHelpA := GetProcAddress (LibHandle, 'HtmlHelpA');
- @HtmlHelpW := GetProcAddress (LibHandle, 'HtmlHelpW');
- @HtmlHelp := GetProcAddress (LibHandle, 'HtmlHelpA');
- end;
- finalization
- if LibHandle <> 0 then
- FreeLibrary (LibHandle);
- end.
|