HTMLHelpUnit.pas 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297
  1. {
  2. This Delphi component is part of TIGCC IDE.
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. unit HTMLHelpUnit;
  17. interface
  18. uses
  19. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  20. ShellAPI, Menus;
  21. const
  22. HH_DISPLAY_TOPIC = $0000;
  23. HH_HELP_FINDER = $0000; // WinHelp equivalent
  24. HH_DISPLAY_TOC = $0001;
  25. HH_DISPLAY_INDEX = $0002;
  26. HH_DISPLAY_SEARCH = $0003;
  27. HH_SET_WIN_TYPE = $0004;
  28. HH_GET_WIN_TYPE = $0005;
  29. HH_GET_WIN_HANDLE = $0006;
  30. HH_ENUM_INFO_TYPE = $0007; // Get Info type name, call repeatedly to enumerate, -1 at end
  31. HH_SET_INFO_TYPE = $0008; // Add Info type to filter.
  32. HH_SYNC = $0009;
  33. HH_RESERVED1 = $000A;
  34. HH_RESERVED2 = $000B;
  35. HH_RESERVED3 = $000C;
  36. HH_KEYWORD_LOOKUP = $000D;
  37. HH_DISPLAY_TEXT_POPUP = $000E; // display string resource id or text in a popup window
  38. HH_HELP_CONTEXT = $000F; // display mapped numeric value in dwData
  39. HH_TP_HELP_CONTEXTMENU = $0010; // text popup help, same as WinHelp HELP_CONTEXTMENU
  40. HH_TP_HELP_WM_HELP = $0011; // text popup help, same as WinHelp HELP_WM_HELP
  41. HH_CLOSE_ALL = $0012; // close all windows opened directly or indirectly by the caller
  42. HH_ALINK_LOOKUP = $0013; // ALink version of HH_KEYWORD_LOOKUP
  43. HH_GET_LAST_ERROR = $0014; // not currently implemented // See HHERROR.h
  44. HH_ENUM_CATEGORY = $0015; // Get category name, call repeatedly to enumerate, -1 at end
  45. HH_ENUM_CATEGORY_IT = $0016; // Get category info type members, call repeatedly to enumerate, -1 at end
  46. HH_RESET_IT_FILTER = $0017; // Clear the info type filter of all info types.
  47. HH_SET_INCLUSIVE_FILTER = $0018; // set inclusive filtering method for untyped topics to be included in display
  48. HH_SET_EXCLUSIVE_FILTER = $0019; // set exclusive filtering method for untyped topics to be excluded from display
  49. HH_INITIALIZE = $001C; // Initializes the help system.
  50. HH_UNINITIALIZE = $001D; // Uninitializes the help system.
  51. HH_PRETRANSLATEMESSAGE = $00FD; // Pumps messages. (NULL, NULL, MSG*).
  52. HH_SET_GLOBAL_PROPERTY = $00FC; // Set a global property. (NULL, NULL, HH_GPROP)
  53. type
  54. DWordPtr = DWord;
  55. THHAKLink = packed record
  56. cbStruct: Integer; // Size of this structure
  57. fReserved: Bool; // Must be FALSE (really!)
  58. pszKeywords: LPCTStr; // Semi-colon separated keywords
  59. pszUrl: LPCTStr; // URL to jump to if no keywords found (may be NULL)
  60. pszMsgText: LPCTStr; // Message text to display in MessageBox if pszUrl is NULL and no keyword match
  61. pszMsgTitle: LPCTStr; // Message title to display in MessageBox if pszUrl is NULL and no keyword match
  62. pszWindow: LPCTStr; // Window to display URL in
  63. fIndexOnFail: Bool; // Displays index if keyword lookup fails.
  64. end;
  65. HH_AKLINK = THHAKLink;
  66. tagHH_AKLINK = HH_AKLINK;
  67. PHHAKLink = ^THHAKLink;
  68. THHFTSQuery = record
  69. cbStruct: Integer; // Size of structure in bytes.
  70. fUniCodeStrings: Bool; // TRUE if all strings are unicode.
  71. pszSearchQuery: LPCTStr; // String containing the search query.
  72. iProximity: LongInt; // Word proximity.
  73. fStemmedSearch: Bool; // TRUE for StemmedSearch only.
  74. TitleOnly: Bool; // TRUE for Title search only.
  75. fExecute: Bool; // TRUE to initiate the search.
  76. pszWindow: LPCTStr; // Window to display in
  77. end;
  78. HH_FTS_QUERY = THHFTSQuery;
  79. tagHH_FTS_QUERY = HH_FTS_QUERY;
  80. THtmlHelpAProc = function(hwndCaller: HWnd; pszFile: PAnsiChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
  81. THtmlHelpWProc = function(hwndCaller: HWnd; pszFile: PWideChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
  82. THtmlHelpProc = function(hwndCaller: HWnd; pszFile: PChar; uCommand: UInt; dwData: DWordPtr): HWnd; stdcall;
  83. var
  84. HtmlHelpA: THtmlHelpAProc;
  85. HtmlHelpW: THtmlHelpWProc;
  86. HtmlHelp: THtmlHelpProc;
  87. resourcestring
  88. SHTMLHelpNotInstalled = 'The HTML Help Viewer is not installed. Download it at www.microsoft.com.';
  89. SHTMLHelpFileNotFound = 'The help file could not be found.';
  90. type
  91. EHTMLHelp = class(Exception);
  92. EHTMLHelpNotInstalled = class(EHTMLHelp);
  93. EHTMLHelpFileNotFound = class(EHTMLHelp);
  94. THTMLHelp = class(TComponent)
  95. private
  96. FWindowHandle: HWnd;
  97. FCookie: DWord;
  98. FWindowType: string;
  99. FFileName: string;
  100. FCurrentTopic: string;
  101. FMaximizeOnShow: Boolean;
  102. procedure WndProc(var Msg: TMessage);
  103. function GetFileString: string;
  104. protected
  105. property CurrentTopic: string read FCurrentTopic write FCurrentTopic;
  106. property FileString: string read GetFileString;
  107. public
  108. constructor Create(AOwner: TComponent); override;
  109. destructor Destroy; override;
  110. function SendMessage(pszFile: PChar; uCommand: UInt; dwData: DWordPtr): HWnd;
  111. function Display: Boolean;
  112. function DisplayTopic(const Topic: string): Boolean;
  113. function KeywordLookup(const Keyword: string): Boolean;
  114. function KeywordLookupEx(const Link: THHAKLink): Boolean;
  115. function DisplayContentsTab: Boolean;
  116. function DisplayIndexTab: Boolean;
  117. function DisplaySearchTab: Boolean;
  118. procedure CloseAllWindows;
  119. published
  120. property FileName: string read FFileName write FFileName;
  121. property WindowType: string read FWindowType write FWindowType;
  122. property MaximizeOnShow: Boolean read FMaximizeOnShow write FMaximizeOnShow;
  123. end;
  124. procedure Register;
  125. const
  126. hhctrl = 'hhctrl.ocx';
  127. implementation
  128. procedure Register;
  129. begin
  130. RegisterComponents('Help', [THTMLHelp]);
  131. end;
  132. { THTMLHelp }
  133. procedure THTMLHelp.CloseAllWindows;
  134. begin
  135. SendMessage (nil, HH_CLOSE_ALL, 0);
  136. end;
  137. constructor THTMLHelp.Create;
  138. begin
  139. inherited;
  140. if Assigned (HtmlHelp) then begin
  141. FWindowHandle := AllocateHWnd (WndProc);
  142. HtmlHelp (0, nil, HH_INITIALIZE, DWordPtr (@FCookie));
  143. end;
  144. end;
  145. destructor THTMLHelp.Destroy;
  146. begin
  147. if Assigned (HtmlHelp) then begin
  148. CloseAllWindows;
  149. HtmlHelp (0, nil, HH_UNINITIALIZE, DWordPtr (FCookie));
  150. DeallocateHWnd (FWindowHandle);
  151. end;
  152. inherited;
  153. end;
  154. function THTMLHelp.Display: Boolean;
  155. begin
  156. Result := DisplayTopic ('');
  157. end;
  158. function THTMLHelp.DisplayContentsTab: Boolean;
  159. begin
  160. Display;
  161. Result := SendMessage (PChar (FileString), HH_DISPLAY_TOC, 0) <> 0;
  162. end;
  163. function THTMLHelp.DisplayIndexTab: Boolean;
  164. begin
  165. Display;
  166. Result := SendMessage (PChar (FileString), HH_DISPLAY_INDEX, 0) <> 0;
  167. end;
  168. function THTMLHelp.DisplaySearchTab: Boolean;
  169. var
  170. Query: THHFTSQuery;
  171. begin
  172. Display;
  173. with Query do begin
  174. cbStruct := SizeOf (Query);
  175. fUniCodeStrings := False;
  176. pszSearchQuery := '';
  177. iProximity := 0;
  178. fStemmedSearch := False;
  179. TitleOnly := False;
  180. fExecute := False;
  181. pszWindow := PChar (WindowType);
  182. end;
  183. Result := SendMessage (PChar (FileString), HH_DISPLAY_SEARCH, DWordPtr (@Query)) <> 0;
  184. end;
  185. function THTMLHelp.DisplayTopic(const Topic: string): Boolean;
  186. begin
  187. CurrentTopic := Topic;
  188. Result := SendMessage (PChar (FileString), HH_DISPLAY_TOPIC, 0) <> 0;
  189. end;
  190. function THTMLHelp.GetFileString: string;
  191. begin
  192. if FileName = '' then
  193. Result := ''
  194. else begin
  195. Result := FileName;
  196. if CurrentTopic <> '' then
  197. Result := Result + '::/' + CurrentTopic;
  198. if WindowType <> '' then
  199. Result := Result + '>' + WindowType;
  200. end;
  201. end;
  202. function THTMLHelp.KeywordLookup(const Keyword: string): Boolean;
  203. var
  204. Link: THHAKLink;
  205. begin
  206. if Length (Keyword) > 0 then begin
  207. FillChar (Link, SizeOf (Link), 0);
  208. with Link do begin
  209. cbStruct := SizeOf (Link);
  210. pszKeywords := PChar (Keyword);
  211. fIndexOnFail := True;
  212. end;
  213. Result := KeywordLookupEx (Link);
  214. end else
  215. Result := False;
  216. end;
  217. function THTMLHelp.KeywordLookupEx(const Link: THHAKLink): Boolean;
  218. begin
  219. Result := SendMessage (PChar (FileName), HH_KEYWORD_LOOKUP, DWord (@Link)) <> 0;
  220. end;
  221. function THTMLHelp.SendMessage(pszFile: PChar; uCommand: UInt;
  222. dwData: DWordPtr): HWnd;
  223. begin
  224. if Assigned (pszFile) and (pszFile <> '') and (not FileExists (FileName)) then
  225. raise EHTMLHelpFileNotFound.Create (SHTMLHelpFileNotFound);
  226. if Assigned (HtmlHelp) then
  227. Result := HtmlHelp (FWindowHandle, pszFile, uCommand, dwData)
  228. else
  229. raise EHTMLHelpNotInstalled.Create (SHTMLHelpNotInstalled);
  230. if (Result <> 0) and MaximizeOnShow then
  231. ShowWindow (Result, SW_MAXIMIZE);
  232. end;
  233. procedure THTMLHelp.WndProc(var Msg: TMessage);
  234. begin
  235. if Assigned (HtmlHelp) then
  236. try
  237. if HtmlHelp (0, nil, HH_PRETRANSLATEMESSAGE, DWordPtr (@Msg)) = 0 then
  238. with Msg do
  239. Result := DefWindowProc (FWindowHandle, Msg, wParam, lParam);
  240. except
  241. Application.HandleException (Self);
  242. end
  243. else
  244. with Msg do
  245. Result := DefWindowProc (FWindowHandle, Msg, wParam, lParam);
  246. end;
  247. { HTML Help Initialization }
  248. var
  249. LibHandle: THandle;
  250. initialization
  251. LibHandle := LoadLibrary (hhctrl);
  252. if LibHandle <> 0 then begin
  253. @HtmlHelpA := GetProcAddress (LibHandle, 'HtmlHelpA');
  254. @HtmlHelpW := GetProcAddress (LibHandle, 'HtmlHelpW');
  255. @HtmlHelp := GetProcAddress (LibHandle, 'HtmlHelpA');
  256. end;
  257. finalization
  258. if LibHandle <> 0 then
  259. FreeLibrary (LibHandle);
  260. end.