HTMLHelpUnit.pas 8.7 KB

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