怎样调用.chm文件？(50分)

honghs · 2000-11-15

想知道是吧，有个控件，我也不知道从那下的了，只好浪费一点大家的时间把代码copy上来 有这些功能吧 Close help window This button closes an open help window. Show table of contents If you click this button, it executes the command: application.helpcommand(HELP_FINDER, 0); Show default topic This will display the default topic of your help file ("introduction" or so). If you click this button, it executes the command: application.helpcommand(HELP_CONTENT, 0); Display topic Select a topic from the combo box left of the button. Then click to display the topic. The button executes the command: if Combobox1.text <> '' then HTMLhelpRouter1.HelpJump('', Combobox1.text); Jump directly to a keyword Enter a keyword in the edit box left of the button. Then click to jump directly to the keyword. If your keyword is not found, no topic is displayed. If the keyword occours in more than one topic (for example the keyword "keyword" in this help file), a list of topics is displayed. The button executes the command: HTMLhelpRouter1.HelpKLink(Edit2.text); Jump to an A-keyword Select an A-keyword in the combo box left of the button. Then click to jump directly to the A-keyword. If your A-keyword is not found, no topic is displayed. If the keyword occours in more than one topic , a list of topics is displayed. HTMLhelpRouter1.HelpALink(Combobox2.text); Display topic Select a topic from the combo box left of the button. Then click to display the topic. The button executes the command: if Combobox1.text <> '' then HTMLhelpRouter1.HelpJump('', Combobox1.text); Show default topic This will display the default topic of your help file ("introduction" or so). If you click this button, it executes the command: application.helpcommand(HELP_CONTENT, 0); //***************************** (*==================================================================== THTMLHelpRouter Delphi 2/3/4 Implementation of HTML HELP EMail: info@ec-software.com Internet: http://www.ec-software.com Disclaimer of Warranty ---------------------- THIS SOFTWARE AND THE ACCOMPANYING FILES ARE PROVIDED "AS IS" AND WITHOUT WARRANTIES OF ANY KIND WHETHER EXPRESSED OR IMPLIED. In no event shall the author be held liable for any damages whatsoever, including without limitation, damages for loss of business profits, business interruption, loss of business information, or any other loss arising from the use or inability to use  the software. ====================================================================*) unit HelpRouter; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   Menus; const    HH_DISPLAY_TOPIC        = $0000;    HH_HELP_FINDER          = $0000;  // WinHelp equivalent    HH_DISPLAY_TOC          = $0001;  // not currently implemented    HH_DISPLAY_INDEX        = $0002;  // not currently implemented    HH_DISPLAY_SEARCH       = $0003;  // not currently implemented    HH_SET_WIN_TYPE         = $0004;    HH_GET_WIN_TYPE         = $0005;    HH_GET_WIN_HANDLE       = $0006;    HH_ENUM_INFO_TYPE       = $0007;    HH_SET_INFO_TYPE        = $0008;    HH_SYNC                 = $0009;    HH_RESERVED1            = $000A;    HH_RESERVED2            = $000B;    HH_RESERVED3            = $000C;    HH_KEYWORD_LOOKUP       = $000D;    HH_DISPLAY_TEXT_POPUP   = $000E;    HH_HELP_CONTEXT         = $000F;    HH_TP_HELP_CONTEXTMENU  = $0010;    HH_TP_HELP_WM_HELP      = $0011;    HH_CLOSE_ALL            = $0012;    HH_ALINK_LOOKUP         = $0013;    HH_GET_LAST_ERROR       = $0014;    HH_ENUM_CATEGORY        = $0015;    HH_ENUM_CATEGORY_IT     = $0016;    HH_RESET_IT_FILTER      = $0017;    HH_SET_INCLUSIVE_FILTER = $0018;    HH_SET_EXCLUSIVE_FILTER = $0019;    HH_INITIALIZE           = $001C;    HH_UNINITIALIZE         = $001D;    HH_PRETRANSLATEMESSAGE  = $00fd;    HH_SET_GLOBAL_PROPERTY  = $00fc; type    THH_POPUP = record       cbStruct: integer;       hinst: THandle;       idString: cardinal;       pszText: PChar;       pt: TPoint;       clrForeground: TColor;       clrBackground: TColor;       rcMargins: TRect;       pszFont: PChar;    end; type    THH_AKLINK = record       cbStruct: integer;       fReserved: boolean;       pszKeywords: Pchar;       pszUrl: Pchar;       pszMsgText: PChar;       pszMsgTitle: PChar;       pszMsgWindow: PChar;       fIndexOnFail: boolean;    end; type   THelpType = (htAuto, htWinhelp, htHTMLhelp);   EOwnerError = class(Exception);   THTMLhelpRouter = class(TComponent)   private     fHelpType: THelpType;     fAppOnHelp: THelpEvent;     function  CurrentForm: TForm;     function  OnRouteHelp(Command: Word; Data: Longint; var CallHelp: Boolean): Boolean;     function  FindHandle(var Helphandle: HWND; var Helpfile: string): boolean;     procedure SetHelpType(value: THelpType);   protected   public     constructor Create(AOwner: TComponent); override;     destructor  Destroy; override;     function    HTMLhelpInstalled: boolean;     function    HelpContent: boolean;     function    HelpKeyword(keyword: string): boolean;     function    HelpKLink(keyword: string): boolean;     function    HelpALink(akeyword: string): boolean;     function    HelpJump(helpfile, topicid: string): boolean;     function    HelpPopup(X,Y: integer; text: string): boolean;   published     property HelpType: THelpType read fHelpType write SetHelpType;   end; type    THtmlHelpA = function(hwndCaller: THandle; pszFile: PChar; uCommand: cardinal; dwData: longint): THandle; stdCall; var    HtmlHelpA: THtmlHelpA;    HHCTRL: THandle;    GLOBAL_HELPROUTER: THTMLhelpRouter; procedure Register; implementation function LoadHHCTRL: boolean; begin   if HHCTRL = 0 then   begin     HtmlHelpA := nil;     HHCTRL := LoadLibrary('HHCTRL.OCX');     if (HHCTRL <> 0) then HtmlHelpA := GetProcAddress(HHCTRL, 'HtmlHelpA');   end;   result := HHCTRL <> 0; end; function CheckRouterInstance: boolean; begin   result := false;   if GLOBAL_HELPROUTER <> NIL then raise Exception.Create('Multiple instances of THTMLhelpRouter are not allowed')   else result := true; end; { --- THTMLhelpRouter --- } constructor THTMLhelpRouter.Create(AOwner: TComponent); begin   inherited Create(AOwner);   if CheckRouterInstance then   begin        fAppOnHelp := Application.onhelp;        Application.onhelp := OnRouteHelp;        GLOBAL_HELPROUTER := Self;   end; end; destructor THTMLhelpRouter.Destroy; begin   if assigned(fAppOnHelp) then Application.onhelp := fAppOnHelp;   GLOBAL_HELPROUTER := nil;   inherited Destroy; end; function THTMLhelpRouter.CurrentForm: TForm; begin   if Screen.ActiveForm <> NIL then        Result:= Screen.ActiveForm   else Result:= Owner as TForm; end; procedure THTMLhelpRouter.SetHelpType(value: THelpType); begin      if value <> fHelpType then      begin           fHelpType := value;           if fHelpType in [htAuto,htHTMLhelp] then LoadHHCTRL;      end; end; function THTMLhelpRouter.HTMLhelpInstalled: boolean; begin   if HHCTRL = 0 then LoadHHCTRL;   result := assigned(HtmlHelpA); end; function THTMLhelpRouter.FindHandle(var Helphandle: HWND; var Helpfile: string): boolean; var    CForm: TForm; begin    case HelpType of       htWinhelp:  result := false;       htHTMLhelp: result := true;       htAuto:     result := HTMLhelpInstalled;    end;    HelpFile := Application.helpfile;    HelpHandle := Application.handle; {IFDEF VER100}    CForm := CurrentForm;    if Assigned(CForm) and CForm.HandleAllocated and (CForm.HelpFile <> '') then    begin        HelpHandle := CForm.Handle;        HelpFile := CForm.HelpFile;    end; {ENDIF} end; function THTMLhelpRouter.OnRouteHelp(Command: Word; Data: Longint; var CallHelp: Boolean): Boolean; var    showHTML: boolean;    rHandle: integer;    HelpHandle: HWND;    HelpFile: string; //   IDS: array[0..2] of DWORD; begin    if assigned(fAppOnHelp) then result := fAppOnHelp(command, data, callhelp);    if not callHelp then exit;    showHTML := FindHandle(HelpHandle, HelpFile);    result := false;    if showHTML then    begin      rHandle := 0;      HelpFile := changefileext(Helpfile,'.chm');      case Command of      HELP_FINDER, HELP_CONTENTS: rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_DISPLAY_TOC, 0);  //show table of contents      HELP_KEY: rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_DISPLAY_INDEX, data);  //display keywordshow table of contens      HELP_QUIT: rHandle := HtmlHelpA(helphandle, nil, HH_CLOSE_ALL, 0);      HELP_CONTEXT: rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_HELP_CONTEXT, data);  //display help context      HELP_CONTEXTPOPUP: rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_HELP_CONTEXT, data);      end;      Result := rHandle <> 0;    end;    if (not result) and (fHelpType <> htHTMLhelp) then    begin      Result := WinHelp(HelpHandle, PChar(changefileext(HelpFile,'.hlp')), Command, Data);    end;    CallHelp := false; end; function THTMLhelpRouter.HelpContent: boolean; begin    result := application.helpcommand(HELP_FINDER, 0); end; function THTMLhelpRouter.HelpJump(helpfile, topicid: string): boolean; var    Command: array[0..255] of Char;    showHTML: boolean;    rHandle: integer;    HelpHandle: HWND;    HFile, HID: string;    CForm: TForm; begin    result := false;    showHTML := FindHandle(HelpHandle, HFile);    if Helpfile <> '' then    begin         HFile := HelpFile;         HelpHandle := 0;    end;    if showHTML then    begin      rHandle := 0;      HelpFile := changefileext(HFile,'.chm');      HID := TopicID;      if copy(lowercase(extractfileext(HID)),1,4) <> '.htm' then HID := HID + '.htm';      rHandle := HtmlHelpA(helphandle, pchar(Helpfile+'::/'+HID), HH_DISPLAY_TOPIC, 0);  //show table of contents      Result := rHandle <> 0;    end;    if (not result) and (fHelpType <> htHTMLhelp) then    begin      helpfile := changefileext(HFile,'.hlp');      StrLFmt(Command, SizeOf(Command) - 1, 'JumpID("","%s")', [TopicID]);      Result := WinHelp(HelpHandle, PChar(Helpfile), HELP_CONTENTS, 0);      if Result then Result := WinHelp(HelpHandle, PChar(helpfile), HELP_COMMAND, Longint(@Command));    end; end; function THTMLhelpRouter.HelpPopup(X,Y: integer; text: string): boolean; var    CForm: TForm;    HP: THH_Popup; begin    if (fHelpType <> htWinhelp) and HTMLhelpInstalled then    begin      CForm := CurrentForm;      with HP do      begin           cbStruct := sizeof(HP);           hInstance := 0;           idString := 0;           pszText := PChar(text);           pt.x := X;           pt.y := Y;           ClientToScreen(CForm.handle, pt);           clrForeground := -1;           clrBackground := -1;           rcMargins.Left := -1;           rcMargins.Right := -1;           rcMargins.Top := -1;           rcMargins.Bottom := -1;           pszFont := PChar('MS Sans Serif, 10');      end;      result := HtmlHelpA(CForm.handle, nil, HH_DISPLAY_TEXT_POPUP, longint(@HP)) <> 0;    end    else result := false; end; function THTMLhelpRouter.HelpKeyword(keyword: string): boolean; var   Command: array[0..255] of Char; begin   StrLcopy(Command, pchar(keyword), SizeOf(Command) - 1);   result := application.helpcommand(HELP_KEY, Longint(@Command)); end; function THTMLhelpRouter.HelpKLink(keyword: string): boolean; var    Command: array[0..255] of Char;    showHTML: boolean;    rHandle: integer;    HelpHandle: HWND;    HFile, Helpfile: string;    CForm: TForm;    HA: THH_AKLINK; begin    result := false;    showHTML := FindHandle(HelpHandle, HFile);    if showHTML then    begin      rHandle := 0;      HelpFile := changefileext(HFile,'.chm');      with HA do      begin           cbStruct := sizeof(HA);           fReserved := false;           pszKeywords := pchar(keyword);           pszUrl := '';           pszMsgText := '';           pszMsgTitle := '';           pszMsgWindow := '';           fIndexOnFail := true;      end;      rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_DISPLAY_TOPIC, 0);  //create window      if rHandle <> 0 then rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_KEYWORD_LOOKUP, longint(@HA));      Result := rHandle <> 0;    end;    if (not result) and (fHelpType <> htHTMLhelp) then    begin      helpfile := changefileext(HFile,'.hlp');      StrLFmt(Command, SizeOf(Command) - 1, 'KL("%s",1)', [keyword]);      Result := WinHelp(HelpHandle, PChar(Helpfile), HELP_CONTENTS, 0);      if Result then Result := WinHelp(HelpHandle, PChar(helpfile), HELP_COMMAND, Longint(@Command));    end; end; function THTMLhelpRouter.HelpALink(akeyword: string): boolean; var    Command: array[0..255] of Char;    showHTML: boolean;    rHandle: integer;    HelpHandle: HWND;    HFile, Helpfile: string;    CForm: TForm;    HA: THH_AKLINK; begin    result := false;    showHTML := FindHandle(HelpHandle, HFile);    if showHTML then    begin      rHandle := 0;      HelpFile := changefileext(HFile,'.chm');      with HA do      begin           cbStruct := sizeof(HA);           fReserved := false;           pszKeywords := pchar(akeyword);           pszUrl := '';           pszMsgText := '';           pszMsgTitle := '';           pszMsgWindow := '';           fIndexOnFail := true;      end;      rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_DISPLAY_TOPIC, 0);  //create window      if rHandle <> 0 then rHandle := HtmlHelpA(helphandle, pchar(Helpfile), HH_ALINK_LOOKUP, longint(@HA));      Result := rHandle <> 0;    end;    if (not result) and (fHelpType <> htHTMLhelp) then    begin      helpfile := changefileext(HFile,'.hlp');      StrLFmt(Command, SizeOf(Command) - 1, 'AL("%s",1)', [akeyword]);      Result := WinHelp(HelpHandle, PChar(Helpfile), HELP_CONTENTS, 0);      if Result then Result := WinHelp(HelpHandle, PChar(helpfile), HELP_COMMAND, Longint(@Command));    end; end; procedure Register; begin   RegisterComponents('EC', [THTMLhelpRouter]); end; initialization   HHCTRL := 0; finalization    if (HHCTRL <> 0) then FreeLibrary(HHCTRL); end. //*****************

netsong · 2000-11-22

多人接受答案了。

怎样调用.chm文件？(50分)

honghs

Unregistered / Unconfirmed

netsong

Unregistered / Unconfirmed

Similar threads