Delphi - база знаний

Как использовать CHM help в своём проекте?


Как использовать CHM help в своём проекте?





Всё, что вам надо сделать, это сохранить ниже приведенный модуль на диске и добавить его в Uses вашего проекта. После этого Вы сможете использовать CHM файлы точно так же как и обычные HLP файлы.

unit StoHtmlHelp;
////////////////////////////////////////////////////////////////


// Implementation of context sensitive HTML help (.chm) for Delphi.
//
// Version:       1.2
// Author:        Martin Stoeckli
// Homepage:      www.martinstoeckli.ch/delphi
// Copyright(c):  Martin Stoeckli 2002
//
// Restrictions:  - Works only under the Windows platform.
//                - Is written for Delphi v7, should work from v6 up.
//
// Description
// ***********
// This unit enables you to call ".chm" files from your Delphi projects.
// You can use the normal Delphi VCL framework, write your projects the
// same way, as you would using normal ".hlp" files.
//
// Installation
// ************
// Simply add this unit to your project, that's all.
//
// If your help project contains files with the extension ".html"
// instead of ".htm", then you can either pass the filename with the
// extension to Application.HelpJump(), or you can set the property
// "HtmlExt" of the global object in this unit.
//   StoHelpViewer.HtmlExt := '.html';
//
// Examples
// ********
//   // assign a helpfile, you could also select the helpfile at the
//   // options dialog "Project/Options.../Application".
//   Application.HelpFile := 'C:\MyHelp.chm';
//   ...
//   // shows the contents of the helpfile
//   Application.HelpCommand(HELP_CONTENTS, 0);
//   // or
//   Application.HelpSystem.ShowTableOfContents;
//   ...
//   // opens the context sensitive help with a numerical id.
//   // you could do the same by setting the "HelpContext"
//   // property of a component and pressing the F1 key.
//   Application.HelpContext(1000);
//   // or with a string constant
//   Application.HelpJump('welcome');
//   ...
//   // opens the help index with a keyword.
//   // you could do the same by setting the "HelpKeyword"
//   // property of a component and pressing the F1 key.
//   Application.HelpKeyword('how to do');
//

interface
uses Classes, Windows, HelpIntfs;

type
  THtmlHelpA = function(hwndCaller: HWND; pszFile: LPCSTR; uCommand: UINT; dwData: DWORD): HWND; stdcall;

  TStoHtmlHelpViewer = class(TInterfacedObject, ICustomHelpViewer,
                             IExtendedHelpViewer, IHelpSelector)
  private
    FViewerID: Integer;
    FViewerName: String;
    FHtmlHelpFunction: THtmlHelpA;
  protected
    FHHCtrlHandle: THandle;
    FHelpManager: IHelpManager;
    FHtmlExt: String;
    function  GetHelpFileName: String;
    function  IsChmFile(const FileName: String): Boolean;
    procedure InternalShutdown;
    procedure CallHtmlHelp(const HelpFile: String; uCommand: UINT; dwData: DWORD);
    // ICustomHelpViewer
    function  GetViewerName: String;
    function  UnderstandsKeyword(const HelpString: String): Integer;
    function  GetHelpStrings(const HelpString: String): TStringList;
    function  CanShowTableOfContents: Boolean;
    procedure ShowTableOfContents;
    procedure ShowHelp(const HelpString: String);
    procedure NotifyID(const ViewerID: Integer);
    procedure SoftShutDown;
    procedure ShutDown;
    // IExtendedHelpViewer
    function  UnderstandsTopic(const Topic: String): Boolean;
    procedure DisplayTopic(const Topic: String);
    function  UnderstandsContext(const ContextID: Integer;
      const HelpFileName: String): Boolean;
    procedure DisplayHelpByContext(const ContextID: Integer;
      const HelpFileName: String);
    // IHelpSelector
    function  SelectKeyword(Keywords: TStrings) : Integer;
    function  TableOfContents(Contents: TStrings): Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property HtmlExt: String read FHtmlExt write FHtmlExt;
  end;

var
  StoHelpViewer: TStoHtmlHelpViewer;

implementation
uses Forms, SysUtils, WinHelpViewer;

const
  // imported from HTML Help Workshop
  HH_DISPLAY_TOPIC        = $0000;
  HH_HELP_FINDER          = $0000; // WinHelp equivalent
  HH_DISPLAY_TOC          = $0001;
  HH_DISPLAY_INDEX        = $0002;
  HH_DISPLAY_SEARCH       = $0003;
  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

type
  TStoWinHelpTester = class(TInterfacedObject, IWinHelpTester)
  protected
    // IWinHelpTester
    function CanShowALink(const ALink, FileName: String): Boolean;
    function CanShowTopic(const Topic, FileName: String): Boolean;
    function CanShowContext(const Context: Integer;
                            const FileName: String): Boolean;
    function GetHelpStrings(const ALink: String): TStringList;
    function GetHelpPath : String;
    function GetDefaultHelpFile: String;
    function IsHlpFile(const FileName: String): Boolean;
  end;

////////////////////////////////////////////////////////////////
// like "Application.ExeName", but in a DLL you get the name of
// the DLL instead of the application name
function Sto_GetModuleName: String;
var
  szFileName: array[0..MAX_PATH] of Char;
begin
  FillChar(szFileName, SizeOf(szFileName), #0);
  GetModuleFileName(hInstance, szFileName, MAX_PATH);
  Result := szFileName;
end;

////////////////////////////////////////////////////////////////
{ TStoHtmlHelpViewer }
////////////////////////////////////////////////////////////////

procedure TStoHtmlHelpViewer.CallHtmlHelp(const HelpFile: String; uCommand: UINT; dwData: DWORD);
begin
  if Assigned(FHtmlHelpFunction) then
  begin
    case uCommand of
    HH_CLOSE_ALL: FHtmlHelpFunction(0, nil, uCommand, dwData); // special parameters
    HH_GET_LAST_ERROR: ; // ignore
    else
      FHtmlHelpFunction(FHelpManager.GetHandle, PChar(HelpFile), uCommand, dwData);
    end;
  end;
end;

function TStoHtmlHelpViewer.CanShowTableOfContents: Boolean;
begin
  Result := True;
end;

constructor TStoHtmlHelpViewer.Create;
begin
  inherited Create;
  FViewerName := 'StoHtmlHelp';
  FHtmlExt := '.htm';
  // load dll
  FHHCtrlHandle := LoadLibrary('HHCtrl.ocx');
  if (FHHCtrlHandle <> 0) then
    FHtmlHelpFunction := GetProcAddress(FHHCtrlHandle, 'HtmlHelpA');
end;

destructor TStoHtmlHelpViewer.Destroy;
begin
  StoHelpViewer := nil;
  // free dll
  FHtmlHelpFunction := nil;
  if (FHHCtrlHandle <> 0) then
    FreeLibrary(FHHCtrlHandle);
  inherited Destroy;
end;

procedure TStoHtmlHelpViewer.DisplayHelpByContext(const ContextID: Integer;
  const HelpFileName: String);
var
  sHelpFile: String;
begin
  sHelpFile := GetHelpFileName;
  if IsChmFile(sHelpFile) then
    CallHtmlHelp(sHelpFile, HH_HELP_CONTEXT, ContextID);
end;

procedure TStoHtmlHelpViewer.DisplayTopic(const Topic: String);
var
  sHelpFile: String;
  sTopic: String;
  sFileExt: String;
begin
  sHelpFile := GetHelpFileName;
  if IsChmFile(sHelpFile) then
  begin
    // prepare topicname as a html page
    sTopic := Topic;
    sFileExt := LowerCase(ExtractFileExt(sTopic));
    if (sFileExt <> '.htm') and (sFileExt <> '.html') then
      sTopic := sTopic + FHtmlExt;
    CallHtmlHelp(sHelpFile + '::/' + sTopic, HH_DISPLAY_TOPIC, 0);
  end;
end;

function TStoHtmlHelpViewer.GetHelpFileName: String;
var
  sPath: String;
begin
  Result := '';
  // ask for the helpfile name
  if Assigned(FHelpManager) then
    Result := FHelpManager.GetHelpFile;
  if (Result = '') then
    Result := Application.CurrentHelpFile;
  // if no path is specified, then add the application path
  // (otherwise the file won't be found if the current directory is wrong).
  if (Result <> '') then
  begin
    sPath := ExtractFilePath(Result);
    if (sPath = '') then
      Result := ExtractFilePath(Sto_GetModuleName) + Result;
  end;
end;

function TStoHtmlHelpViewer.GetHelpStrings(const HelpString: String): TStringList;
begin
  // create a tagged keyword
  Result := TStringList.Create;
  Result.Add(Format('%s: %s', [FViewerName, HelpString]));
end;

function TStoHtmlHelpViewer.GetViewerName: String;
begin
  Result := FViewerName;
end;

procedure TStoHtmlHelpViewer.InternalShutdown;
begin
  if Assigned(FHelpManager) then
  begin
    FHelpManager.Release(FViewerID);
    FHelpManager := nil;
  end;
end;

function TStoHtmlHelpViewer.IsChmFile(const FileName: String): Boolean;
var
  iPos: Integer;
  sFileExt: String;
begin
  // find extension
  iPos := LastDelimiter('.', FileName);
  if (iPos > 0) then
  begin
    sFileExt := Copy(FileName, iPos, Length(FileName));
    Result := CompareText(sFileExt, '.chm') = 0;
  end
  else
    Result := False;
end;

procedure TStoHtmlHelpViewer.NotifyID(const ViewerID: Integer);
begin
  FViewerID := ViewerID;
end;

function TStoHtmlHelpViewer.SelectKeyword(Keywords: TStrings): Integer;
var
  i: Integer;
  sViewerName: String;
begin
  Result := 0;
  i := 0;
  // find first tagged line (see GetHelpStrings)
  while (Result = 0) and (i <= Keywords.Count - 1) do
  begin
    sViewerName := Keywords.Strings[i];
    Delete(sViewerName, Pos(':', sViewerName), Length(sViewerName));
    if (FViewerName = sViewerName) then
      Result := i
    else
      Inc(i);
  end;
end;

procedure TStoHtmlHelpViewer.ShowHelp(const HelpString: String);
var
  sHelpFile: String;
  sHelpString: String;
begin
  sHelpFile := GetHelpFileName;
  if IsChmFile(sHelpFile) then
  begin
    // remove the tag if necessary (see GetHelpStrings)
    sHelpString := HelpString;
    Delete(sHelpString, 1, Pos(':', sHelpString));
    sHelpString := Trim(sHelpString);
    CallHtmlHelp(sHelpFile, HH_DISPLAY_INDEX, DWORD(Pchar(sHelpString)));
  end;
end;

procedure TStoHtmlHelpViewer.ShowTableOfContents;
var
  sHelpFile: String;
begin
  sHelpFile := GetHelpFileName;
  if IsChmFile(sHelpFile) then
    CallHtmlHelp(sHelpFile, HH_DISPLAY_TOC, 0);
end;

procedure TStoHtmlHelpViewer.ShutDown;
begin
  SoftShutDown;
  if Assigned(FHelpManager) then
    FHelpManager := nil;
end;

procedure TStoHtmlHelpViewer.SoftShutDown;
begin
  CallHtmlHelp('', HH_CLOSE_ALL, 0);
end;

function TStoHtmlHelpViewer.TableOfContents(Contents: TStrings): Integer;
begin
  // find line with viewer name
  Result := Contents.IndexOf(FViewerName);
end;

function TStoHtmlHelpViewer.UnderstandsContext(const ContextID: Integer;
  const HelpFileName: String): Boolean;
begin
  Result := IsChmFile(HelpFileName);
end;

function TStoHtmlHelpViewer.UnderstandsKeyword(const HelpString: String): Integer;
begin
  if IsChmFile(GetHelpFileName) then
    Result := 1
  else
    Result := 0;
end;

function TStoHtmlHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
  Result := IsChmFile(GetHelpFileName);
end;

////////////////////////////////////////////////////////////////
{ TStoWinHelpTester }
//
// delphi will call the WinHelpTester to determine, if the default
// winhelp should handle the requests.
// don't allow anything, because delphi (v7) will create an invalid
// helpfile path, calling GetHelpPath (it puts a pathdelimiter
// before the filename in "TWinHelpViewer.HelpFile").
////////////////////////////////////////////////////////////////

function TStoWinHelpTester.CanShowALink(const ALink,
  FileName: String): Boolean;
begin
  Result := False;
//  Result := IsHlpFile(FileName);
end;

function TStoWinHelpTester.CanShowContext(const Context: Integer;
  const FileName: String): Boolean;
begin
  Result := False;
//  Result := IsHlpFile(FileName);
end;

function TStoWinHelpTester.CanShowTopic(const Topic,
  FileName: String): Boolean;
begin
  Result := False;
//  Result := IsHlpFile(FileName);
end;

function TStoWinHelpTester.GetDefaultHelpFile: String;
begin
  Result := '';
end;

function TStoWinHelpTester.GetHelpPath: String;
begin
  Result := '';
end;

function TStoWinHelpTester.GetHelpStrings(
  const ALink: String): TStringList;
begin
  // as TWinHelpViewer would do it
  Result := TStringList.Create;
  Result.Add(': ' + ALink);
end;

function TStoWinHelpTester.IsHlpFile(const FileName: String): Boolean;
var
  iPos: Integer;
  sFileExt: String;
begin
  // file has extension '.hlp' ?
  iPos := LastDelimiter('.', FileName);
  if (iPos > 0) then
  begin
    sFileExt := Copy(FileName, iPos, Length(FileName));
    Result := CompareText(sFileExt, '.hlp') = 0;
  end
  else
    Result := False;
end;

initialization
  StoHelpViewer := TStoHtmlHelpViewer.Create;
  RegisterViewer(StoHelpViewer, StoHelpViewer.FHelpManager);
  Application.HelpSystem.AssignHelpSelector(StoHelpViewer);
  WinHelpTester := TStoWinHelpTester.Create;

finalization
  // do not free StoHelpViewer, because the object is referenced by the
  // interface and will be freed automatically by releasing the last reference
  if Assigned(StoHelpViewer) then
    StoHelpViewer.InternalShutdown;
end.

Взято с сайта




unit HtmlHelp; 

interface 

uses 
  Windows, Graphics; 

const 
  HH_DISPLAY_TOPIC  = $0000; 
  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_GET_INFO_TYPES = $0007; 
  HH_SET_INFO_TYPES = $0008; 
  HH_SYNC           = $0009; 
  HH_ADD_NAV_UI     = $000A; 
  HH_ADD_BUTTON     = $000B; 
  HH_GETBROWSER_APP = $000C; 
  HH_KEYWORD_LOOKUP = $000D; 
  HH_DISPLAY_TEXT_POPUP = $000E; 
  HH_HELP_CONTEXT   = $000F; 

const 
  HHWIN_PROP_ONTOP          = 2; 
  HHWIN_PROP_NOTITLEBAR     = 4; 
  HHWIN_PROP_NODEF_STYLES   = 8; 
  HHWIN_PROP_NODEF_EXSTYLES = 16; 
  HHWIN_PROP_TRI_PANE       = 32; 
  HHWIN_PROP_NOTB_TEXT      = 64; 
  HHWIN_PROP_POST_QUIT      = 128; 
  HHWIN_PROP_AUTO_SYNC      = 256; 
  HHWIN_PROP_TRACKING       = 512; 
  HHWIN_PROP_TAB_SEARCH     = 1024; 
  HHWIN_PROP_TAB_HISTORY    = 2048; 
  HHWIN_PROP_TAB_FAVORITES  = 4096; 
  HHWIN_PROP_CHANGE_TITLE   = 8192; 
  HHWIN_PROP_NAV_ONLY_WIN   = 16384; 
  HHWIN_PROP_NO_TOOLBAR     = 32768; 

const 
  HHWIN_PARAM_PROPERTIES    = 2; 
  HHWIN_PARAM_STYLES        = 4; 
  HHWIN_PARAM_EXSTYLES      = 8; 
  HHWIN_PARAM_RECT          = 16; 
  HHWIN_PARAM_NAV_WIDTH     = 32; 
  HHWIN_PARAM_SHOWSTATE     = 64; 
  HHWIN_PARAM_INFOTYPES     = 128; 
  HHWIN_PARAM_TB_FLAGS      = 256; 
  HHWIN_PARAM_EXPANSION     = 512; 
  HHWIN_PARAM_TABPOS        = 1024; 
  HHWIN_PARAM_TABORDER      = 2048; 
  HHWIN_PARAM_HISTORY_COUNT = 4096; 
  HHWIN_PARAM_CUR_TAB       = 8192; 

const 
  HHWIN_BUTTON_EXPAND     = 2; 
  HHWIN_BUTTON_BACK       = 4; 
  HHWIN_BUTTON_FORWARD    = 8; 
  HHWIN_BUTTON_STOP       = 16; 
  HHWIN_BUTTON_REFRESH    = 32; 
  HHWIN_BUTTON_HOME       = 64; 
  HHWIN_BUTTON_BROWSE_FWD = 128; 
  HHWIN_BUTTON_BROWSE_BCK = 256; 
  HHWIN_BUTTON_NOTES      = 512; 
  HHWIN_BUTTON_CONTENTS   = 1024; 
  HHWIN_BUTTON_SYNC       = 2048; 
  HHWIN_BUTTON_OPTIONS    = 4096; 
  HHWIN_BUTTON_PRINT      = 8192; 
  HHWIN_BUTTON_INDEX      = 16384; 
  HHWIN_BUTTON_SEARCH     = 32768; 
  HHWIN_BUTTON_HISTORY    = 65536; 
  HHWIN_BUTTON_FAVORITES  = 131072; 
  HHWIN_BUTTON_JUMP1      = 262144; 
  HHWIN_BUTTON_JUMP2      = 524288; 
  HHWIN_BUTTON_ZOOM       = HHWIN_Button_Jump2 * 2; 
  HHWIN_BUTTON_TOC_NEXT   = HHWIN_Button_Zoom * 2; 
  HHWIN_BUTTON_TOC_PREV   = HHWIN_Button_Toc_Next * 2; 

const 
  HHWIN_DEF_Buttons = HHWIN_Button_Expand or HHWIN_Button_Back or 
    HHWIN_Button_Options or HHWIN_Button_Print; 

const 
  IDTB_EXPAND      = 200; 
  IDTB_CONTRACT    = 201; 
  IDTB_STOP        = 202; 
  IDTB_REFRESH     = 203; 
  IDTB_BACK        = 204; 
  IDTB_HOME        = 205; 
  IDTB_SYNC        = 206; 
  IDTB_PRINT       = 207; 
  IDTB_OPTIONS     = 208; 
  IDTB_FORWARD     = 209; 
  IDTB_NOTES       = 210; 
  IDTB_BROWSE_FWD  = 211; 
  IDTB_BROWSE_BACK = 212; 
  IDTB_CONTENTS    = 213; 
  IDTB_INDEX       = 214; 
  IDTB_SEARCH      = 215; 
  IDTB_HISTORY     = 216; 
  IDTB_FAVORITES   = 217; 
  IDTB_JUMP1       = 218; 
  IDTB_JUMP2       = 219; 
  IDTB_CUSTOMIZE   = 221; 
  IDTB_ZOOM        = 222; 
  IDTB_TOC_NEXT    = 223; 
  IDTB_TOC_PREV    = 224; 

const 
  HHN_First = Cardinal(-860); 
  HHN_Last  = Cardinal(-879); 

  HHN_NavComplete = HHN_First - 0; 
  HHN_Track       = HHN_First - 1; 

type 
  HHN_Notify = record 
    hdr: Pointer; 
    pszUrl: PWideChar; 
  end

  HH_Popup = record 
    cbStruct: Integer; 
    hinst: THandle; 
    idString: Cardinal; 
    pszText: PChar; 
    pt: TPoint; 
    clrForeground: TColor; 
    clrBackground: TColor; 
    rcMargins: TRect; 
    pszFont: PChar; 
  end

  HH_AKLINK = record 
    cbStruct: Integer; 
    fReserved: bool; 
    pszKeywords: PChar; 
    pszUrl: PChar; 
    pszMsgText: PChar; 
    pszMsgTitle: PChar; 
    pszWindow: PChar; 
    fIndexOnFail: bool; 
  end

type 
  HHWin_NavTypes = (HHWIN_NAVTYPE_TOC, 
    HHWIN_NAVTYPE_INDEX
    HHWIN_NAVTYPE_SEARCH, 
    HHWIN_NAVTYPE_HISTORY, 
    HHWIN_NAVTYPE_FAVOURITES); 

type 
  HH_InfoType  = Longint; 
  PHH_InfoType = ^ HH_InfoType; 

type 
  HHWin_NavTabs = (HHWIN_NavTab_Top, 
    HHWIN_NavTab_Left, 
    HHWIN_NavTab_Bottom); 

const 
  HH_Max_Tabs = 19; 

type 
  HH_Tabs = (HH_TAB_CONTENTS, 
    HH_TAB_INDEX
    HH_TAB_SEARCH, 
    HH_TAB_HISTORY, 
    HH_TAB_FAVORITES 
    ); 

const 
  HH_FTS_DEFAULT_PROXIMITY = (-1); 

type 
  HH_FTS_Query = record 
    cbStruct: Integer; 
    fUniCodeStrings: bool; 
    pszSearchQuery: PChar; 
    iProximity: Longint; 
    fStemmedSearch: bool; 
    fTitleOnly: bool; 
    fExecute: bool; 
    pszWindow: PChar; 
  end

type 
  HH_WinType = record 
    cbStruct: Integer; 
    fUniCodeStrings: bool; 
    pszType: PChar; 
    fsValidMembers: Longint; 
    fsWinProperties: Longint; 
    pszCaption: PChar; 
    dwStyles: Longint; 
    dwExStyles: Longint; 
    rcWindowPos: TRect; 
    nShowState: Integer; 
    hwndHelp: THandle; 
    hwndCaller: THandle; 
    paInfoTypes: ^ HH_InfoType; 
    hwndToolbar: THandle; 
    hwndNavigation: THandle; 
    hwndHTML: THandle; 
    iNavWidth: Integer; 
    rcHTML: TRect; 
    pszToc: PChar; 
    pszIndex: PChar; 
    pszFile: PChar; 
    pszHome: PChar; 
    fsToolbarFlags: Longint; 
    fNotExpanded: bool; 
    curNavType: Integer; 
    tabPos: Integer; 
    idNotify: Integer; 
    TabOrder: array[0..HH_Max_Tabs + 1] of Byte; 
    cHistory: Integer; 
    pszJump1: PChar; 
    pszJump2: PChar; 
    pszUrlJump1: PChar; 
    pszUrlJump2: PChar; 
    rcMinSize: TRect; 
  end

  PHH_WinType = ^ HH_WinType; 

type 
  HHACTTYpes = (HHACT_TAB_CONTENTS, 
    HHACT_TAB_INDEX
    HHACT_TAB_SEARCH, 
    HHACT_TAB_HISTORY, 
    HHACT_TAB_FAVORITES, 

    HHACT_EXPAND, 
    HHACT_CONTRACT, 
    HHACT_BACK, 
    HHACT_FORWARD
    HHACT_STOP, 
    HHACT_REFRESH, 
    HHACT_HOME, 
    HHACT_SYNC, 
    HHACT_OPTIONS, 
    HHACT_PRINT, 
    HHACT_HIGHLIGHT, 
    HHACT_CUSTOMIZE, 
    HHACT_JUMP1, 
    HHACT_JUMP2, 
    HHACT_ZOOM, 
    HHACT_TOC_NEXT, 
    HHACT_TOC_PREV, 
    HHACT_NOTES, 

    HHACT_LAST_ENUM 
    ); 

type 
  HHNTRACK = record 
    hdr: TNMHDR; 
    pszCurUrl: PWideChar; 
    idAction: Integer; 
    phhWinType: ^ HH_WinType; 
  end
  PHHNTRACK = ^ HHNTRACK; 

  HHNNAVCOMPLETE = record 
    hdr: TNMHDR; 
    pszUrl: PChar; 
  end
  PHHNNAVCOMPLETE = ^ HHNNAVCOMPLETE; 

type 
  THtmlHelpA = function(hwndCaller: THandle; pszFile: PChar; 
    uCommand: Cardinal; dwData: Longint): THandle;  
  stdCall
  THtmlHelpW = function(hwndCaller: THandle; pszFile: PChar; 
    uCommand: Cardinal; dwData: Longint): THandle;  
  stdCall

function HH(hwndCaller: THandle; pszFile: PChar; uCommand: Cardinal; 
  dwData: Longint): THandle; 
function HtmlHelpInstalled: Boolean; 

implementation 

const 
  ATOM_HTMLHELP_API_ANSI = #14#0; 
  ATOM_HTMLHELP_API_UNICODE = #15#0; 

var 
  HtmlHelpA: THtmlHelpA; 
  OCXHandle: THandle; 

function HH; 
begin 
  Result := 0; 
  if (Assigned(HtmlHelpA)) then  
  begin 
    Result := HtmlHelpA(hwndCaller, pszFile, uCommand, dwData); 
  end
end

function HtmlHelpInstalled: Boolean; 
begin 
  Result := (Assigned(HtmlHelpA)); 
end

initialization 
  begin 
    HtmlHelpA := nil
    OCXHandle := LoadLibrary('HHCtrl.OCX'); 
    if (OCXHandle <> 0) then  
    begin 
      HtmlHelpA := GetProcAddress(OCXHandle, 'HtmlHelpA'); 
    end
  end

finalization 
  begin 
    if (OCXHandle <> 0) then 
      FreeLibrary(OCXHandle); 
  end
end
//----------------------------------------------- 

unit Unit1; 

{....} 

implementation 

uses 
  HtmlHelp; 

const 
  HH_HELP_CONTEXT = $F; 
  MYHELP_FILE = 'DualHelp.chm' + Chr(0); 
var 
  RetCode: LongInt; 

  {$R *.DFM} 

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
begin 
  if Key = vk_f1 then 
  begin 
    if HtmlHelpInstalled = True then 
    begin 
      RetCode := HH(Form1.Handle, PChar(MYHELP_FILE), HH_HELP_CONTEXT, 
        ActiveControl.HelpContext); 
      Key     := 0; //eat it! 
    end  
    else 
      helpfile := 'hhtest.hlp'; 
  end
end

Взято с сайта





Содержание раздела