Справочная система

Тема в разделе "Delphi - Система", создана пользователем @rtem, 5 апр 2007.

  1. @rtem

    @rtem Гость

    Репутация:
    0
    Привет, у меня такой вопрос: ктонить делал в своих проектах справочную систему по типу винды? Я сделал детальное описание программы, сделал его в виде справки (*.сhm, *.hlp), а как его подключить к приложению, что бы это была справка как в системе (вызов справки)?

    Спасибо за помощь.
     
  2. @rtem

    @rtem Гость

    Репутация:
    0
    неа, у меня впрос, есть ли функция вызова справки, что бы на меню сделать обработку вызова.
     
  3. Barmutik

    Barmutik Гость

    Репутация:
    0
    Если HLP файл то пользуетй Application.HelpContext юю если chm файл то после использования HtmlHelp тоже самое .. без него гемороя много .. и не стоит того что бы разбираться ...
     
  4. zubr

    zubr Гость

    Репутация:
    0
    Всё, что вам надо сделать, это сохранить ниже приведенный модуль на диске и добавить его в Uses вашего проекта. После этого Вы сможете использовать CHM файлы точно так же как и обычные HLP файлы.
    Код (Text):
    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.
    Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php


    Код (Text):
    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;
    Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
     
Загрузка...

Поделиться этой страницей