Help - usar help chm nos programas em delphi

Top  Previous  Next

{

  Exemplo completo para chamar um HTMLHelp (.chm) a partir da aplicação Delphi

  Permite o uso de F1 para um componente visual, uso de biHelp do form e chamada

  direta através da função "AbrirHelpContext"

 

  Importante: Não coloque o nome do arquivo de help no Project/Options/HelpFile, nem no Application.HelpFile, 

              pois ao pressionar F1 a aplicação tentará carregar o Htmlhelp (.CHM) que estiver lá, 

                gerando uma exception pois o formato CHM não é suportado pelo Delphi .

                   

  Para testar: crie um help com 3 tópicos com Context ID 10, 20 e 30

    

-----------------------------------------------------------------------------------------------------------}

 

unit Unit1;

 

interface

 

uses Forms, Classes, Controls, StdCtrls, HookHelp, Windows;

 

type

  TForm1 = class(TForm)

    HelpBtn: TButton;

    Button3: TButton;

    Button4: TButton;

    Button5: TButton;

    procedure FormCreate(Sender: TObject);

  private

    function OnHelp_HelpHook(Command: Word; Data: Longint; var CallHelp: Boolean): Boolean;

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  HelpCHM_Arquivo    := 'C:\temp\Teste.chm';

  Application.OnHelp := OnHelp_HelpHook;

end;

 

function TForm1.OnHelp_HelpHook(Command : Word; Data : Longint; Var CallHelp : Boolean) : Boolean;

begin

  Result := AbrirHelpContext(Data);

end;

 

end.

 

// ----------------------------------- form1.dfm -----------------------------------------------

 

object Form1: TForm1

  Left = 330

  Top = 260

  BorderIcons = [biSystemMenu, biHelp]

  Caption = 'Form1 - Cxt=1000'

  ClientHeight = 340

  ClientWidth = 592

  Color = clBtnFace

  Constraints.MinHeight = 367

  Constraints.MinWidth = 600

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = True

  Position = poScreenCenter

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object HelpBtn: TButton

    Left = 224

    Top = 108

    Width = 129

    Height = 25

    HelpContext = 10

    Caption = '10'

    TabOrder = 0

  end

  object Button3: TButton

    Left = 224

    Top = 140

    Width = 129

    Height = 25

    HelpContext = 20

    Caption = '20'

    TabOrder = 1

  end

  object Button4: TButton

    Left = 224

    Top = 172

    Width = 129

    Height = 25

    HelpContext = 30

    Caption = '30'

    TabOrder = 2

  end

  object Button5: TButton

    Left = 224

    Top = 203

    Width = 129

    Height = 25

    Caption = 'Help do Form'

    TabOrder = 3

  end

end

 

// ==============================================================================================

// ==============================================================================================

// Esta unit abaixo deve ser adicionada ao Path do Project Options. Ela é quem hackeia o OnHelp

// do form para apontar para a OCX que redireciona o help para o CHM. Para mais detalhes:

// http://Helpware.net

 

unit HookHelp;

 

interface

 

uses Classes, Types, Windows, Dialogs;

 

var

  HelpCHM_Arquivo: string;

  HtmlHelpA      : function(hwndCaller: HWND; pszFile: PAnsiChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;

 

function AbrirHelpContext(const IDContext: Cardinal): Boolean;

 

implementation

 

uses HelpIntfs, WinHelpViewer, SysUtils, Forms, Controls, Registry;

 

var

  HHCtrlHandle: THandle = 0;

  ViewerName  : string = 'D6OnHelpFix';

  HtmlHelpW   : function(hwndCaller: HWND; pszFile: PWideChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;

  HtmlHelp    : function(hwndCaller: HWND; pszFile: PChar    ; uCommand: UInt; dwData: DWORD): HWND; stdcall;

 

const

  hhctrlLib        = 'hhctrl.ocx';

  HH_DISPLAY_TOPIC = $0000;

  HH_HELP_CONTEXT  = $000F;

  HH_CLOSE_ALL     = $0012;

 

type

  THTMLHelpViewer = class(TInterfacedObject, ICustomHelpViewer, IExtendedHelpViewer{, ISpecialWinHelpViewer})

  private

   FViewerID: Integer;

  public

   FHelpManager: IHelpManager;

 

   constructor Create;

   destructor Destroy; override;

 

   function HelpFile(const Name: String) : String;

   procedure InternalShutDown;

   procedure HelpCommand_HELP_SETPOPUP_POS;

 

   { ICustomHelpViewer }

   function GetViewerName : String;

   procedure NotifyID(const ViewerID: Integer);

   procedure SoftShutDown;

   procedure ShutDown;

 

   function UnderstandsKeyword(const HelpString: String): Integer;

   function GetHelpStrings(const HelpString: String): TStringList;

   function CanShowTableOfContents: Boolean;

   procedure ShowTableOfContents;

   procedure ShowHelp(const HelpString: String);

 

   { 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);

   property ViewerID : Integer read FViewerID;

   property HelpManager : IHelpManager read FHelpManager write FHelpManager;

  end;

 

 

{ global instance of THTMLHelpViewer which HelpIntfs can talk to. }

var

  HelpViewer : THTMLHelpViewer;

 

{----------------------------------------------------------------------------}

{ THelpSelector                                                              }

{----------------------------------------------------------------------------}

 

 { IHelpSelector. IHelpSelector is used by the HelpSystem to ask the

   application to decide which keyword, out of multiple matches returned

   by multiple different Help Viewers, it wishes to support. If an application

   wishes to support this, it passes an IHelpSelector interface into

   IHelpSystem.AssignHelpSelector. }

type

  THelpSelector = class (TInterfacedObject, IHelpSelector)

  public

    function SelectKeyword(Keywords: TStrings) : Integer;

    function TableOfContents(Contents: TStrings): Integer;

  end;

 

var

  HelpSelector : IHelpSelector;

 

const hhPathRegKey = 'CLSID\{adb880a6-d8ff-11cf-9377-00aa003b7a11}\InprocServer32';

 

function GetPathToHHCtrlOCX: string;

var

  Reg: TRegistry;

begin

  result := '';  //default return

  Reg := TRegistry.Create;

  Reg.RootKey := HKEY_CLASSES_ROOT;

  if reg.OpenKeyReadOnly(hhPathRegKey) then //safer call under NT

  begin

    result := Reg.ReadString('');  //default value

    Reg.CloseKey;

    if (result <> ''and (not FileExists(result)) then  //final check - file must exist

      result := '';

  end;

  Reg.Free;

end;

 

procedure LoadHtmlHelp;

var

  OcxPath: string;

begin

  if HHCtrlHandle = 0 then

  begin

    OcxPath := GetPathToHHCtrlOCX;

    if (OcxPath <> ''and FileExists(OcxPath) then

    begin

      HHCtrlHandle := LoadLibrary(PChar(OcxPath));

      if HHCtrlHandle <> 0 then

      begin

        @HtmlHelpA := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');

        @HtmlHelpW := GetProcAddress(HHCtrlHandle, 'HtmlHelpW');

        @HtmlHelp  := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');

      end;

    end;

  end;

 

  if HHCtrlHandle = 0 then

  begin

    ShowMessage('HTML Help não está instalado neste PC');

    Halt;

  end;

end;

 

procedure UnloadHtmlHelp;

begin

  if HHCtrlHandle <> 0 then

  begin

    FreeLibrary(HHCtrlHandle);

    HHCtrlHandle := 0;

  end;

end;

 

{Note: Never called - Since we are the only Keyword player in town}

function THelpSelector.SelectKeyword(Keywords: TStrings) : Integer;

begin

  Result := 0;      //return index of first item in supplied keyword list

end;

 

{Returning our name poistion in the provided list will ensure that we are used to display the TOC}

function THelpSelector.TableOfContents(Contents: TStrings): Integer;

var I: Integer;

begin

  Result := 0;

  for I := 0 to Contents.count-1 do

    if Contents[I] = ViewerName then    //Found ourselves in the list

      Result := I;

end;

 

{----------------------------------------------------------------------------}

{ TWinHelpTester                                                             }

{----------------------------------------------------------------------------}

 

{ Look though the standard viewer code, WinHelpViewer.pas which this

  module is based on. Typically viewer 1 is first cab off the rank and

  wants to handle the help call. Except... there is this global thing

  "WinHelpTester" which if implemented can override the decisions made

  in Viewer 1. That's what this section is. We implement WinHelpTester

  and can manipulate the decisions made by Viewer 1. Viewer 2 now gets

  a chance to handle all help calls.

 

}

type

  TWinHelpTester = class (TInterfacedObject, IWinHelpTester)

  public

    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;

  end;

 

 

function TWinHelpTester.CanShowALink(const ALink, FileName: string): Boolean;

begin

  Result := FALSE;

end;

 

 

function TWinHelpTester.CanShowTopic(const Topic, FileName: string):

Boolean;

begin

  Result := False;

end;

 

 

function TWinHelpTester.CanShowContext(const Context: Integer; const FileName: string): Boolean;

begin

  Result := False;

end;

 

 

function TWinHelpTester.GetHelpStrings(const ALink: string): TStringList;

begin

  Result := TStringList.Create;

end;

 

 

{Used by HelpeViewer 1 for Linux - ignored for now}

function TWinHelpTester.GetHelpPath: string;

begin

  Result := '';

end;

 

{This will do for now - Not too important if using OnHelp}

function TWinHelpTester.GetDefaultHelpFile: string;

begin

  Result := '';

  if Assigned(HelpViewer) then

    Result := HelpViewer.HelpFile('');

end;

 

 

{----------------------------------------------------------------------------}

{ THTMLHelpViewer                                                            }

{----------------------------------------------------------------------------}

 

constructor THTMLHelpViewer.Create;

begin

  inherited Create;

end;

 

destructor THTMLHelpViewer.Destroy;

begin

  inherited Destroy;

end;

 

 

function THTMLHelpViewer.HelpFile(const Name: String): String;

var

  FileName : String;

begin

  if (Name = ''and Assigned(FHelpManager) then

    FileName := HelpManager.GetHelpFile

  else

    FileName := Name;

  Result := FileName;

end;

 

 

{ InternalShut Down is called from unit finalization if the unit is exiting

  and the Help Manager needs to be informed. }

 

procedure THTMLHelpViewer.InternalShutDown;

begin

  SoftShutDown;

  if Assigned(FHelpManager) then

  begin

    HelpManager.Release(ViewerID);

    if Assigned(FHelpManager) then HelpManager := nil;

  end;

end;

 

{ Send the HELP_SETPOPUP_POS command

  just before a Context help call. }

 

procedure THTMLHelpViewer.HelpCommand_HELP_SETPOPUP_POS;

var

  Control: TWinControl;

  Pt: TSmallPoint;

 

  function ControlHasHelp(const Control: TWinControl) : Boolean;

  begin

    Result := false;

    if (Control.HelpType = htContext) and (Control.HelpContext <> 0)

      then Result := true

    else if (Control.HelpType = htKeyword) and (Control.HelpKeyword <> '') then

      Result := true;

  end;

 

begin

  {This is not the best - since F1 press could have come from a memu -- no way of telling}

  Control := Screen.ActiveControl;

  while (Control <> nil) and ( not ControlHasHelp(Control)) do

    Control := Control.Parent;

  if Control <> nil then begin

    Pt := PointToSmallPoint(Control.ClientToScreen(Point(00)));

    Application.HelpCommand(HELP_SETPOPUP_POS, Longint(Pt));

  end;

end;

 

 

{----------------------------------------------------------------------------}

{ THTMLHelpViewer - ICustomHelpViewer                                        }

{----------------------------------------------------------------------------}

 

function THTMLHelpViewer.GetViewerName : String;

begin

  Result := ViewerName;

end;

 

{ UnderstandsKeyword is a querying function that the Help Manager calls to

  determine if the Viewer provide helps on a particular keyword string. }

function THTMLHelpViewer.UnderstandsKeyword(const HelpString: String): Integer;

begin

  Result := 1;

end;

 

{ GetHelpStrings is used by the Help Manager to display a list of keyword

  matches from which an application's user can select one. It assumes

  that the String List is properly allocated, so this function should

  never return nil. }

 

function THTMLHelpViewer.GetHelpStrings(const HelpString: String): TStringList;

begin

  Result := TStringList.Create;

  Result.Add(GetViewerName + ': ' + HelpString);

end;

 

 

{ CanShowTableOfContents is a querying function that the Help Manager

  calls to determine if the Viewer supports tables of contents. WinHelp

  and HyperHelp both do. }

 

function THTMLHelpViewer.CanShowTableOfContents : Boolean;

begin

  Result := true;

end;

 

 

{ ShowTableOfContents is a command function that the Help Manager uses

  to direct the Viewer to display a table of contents. It is never

  called without being preceded by a call to CanShowTableOfContents. }

 

procedure THTMLHelpViewer.ShowTableOfContents;

begin

  { The Fix!! - data ignored we set to zero}

  Application.HelpCommand(HELP_CONTENTS, 0);

end;

 

 

{ ShowHelp is the function that the Help Manager calls to request that

  a Help Viewer display help for a given keyword. }

procedure THTMLHelpViewer.ShowHelp(const HelpString: String);

var

  HelpCommand: array[0..255of Char;

begin

  StrLFmt(HelpCommand, SizeOf(HelpCommand) -1'%s', [HelpString]);

 

  { The Fix!! }

  Self.HelpCommand_HELP_SETPOPUP_POS;

  Application.HelpCommand(HELP_KEY, Longint(@HelpCommand));

end;

 

 

{ NotifyID is called by the Help Manager after a successful registration

  to provide the Help Viewer with a cookie which uniquely identifies the

  Viewer to the Manager, and can be used in communications between the two. }

 

procedure THTMLHelpViewer.NotifyID(const ViewerID: Integer);

begin

  FViewerID := ViewerID;

end;

 

{ SoftShutDown is called by the help manager to ask the viewer to

  terminate any externally spawned subsystem without shutting itself down. }

 

procedure THTMLHelpViewer.SoftShutDown;

begin

  { The Fix!! }

  {rob: Commented this out - caused an error on a user in Win98}

  //Application.HelpCommand(HELP_QUIT, 0);

end;

 

procedure THTMLHelpViewer.ShutDown;

begin

  SoftShutDown;

  if Assigned(FHelpManager) then HelpManager := nil;

end;

 

{----------------------------------------------------------------------------}

{ THTMLHelpViewer --- IExtendedHelpViewer                                     }

{----------------------------------------------------------------------------}

 

{ UnderstandsTopic is called by the Help Manager to ask if the Viewer

  is capable of displaying a topic-based help query for a given topic. }

 

function THTMLHelpViewer.UnderstandsTopic(const Topic: String): Boolean;

begin

  Result := true;

end;

 

{ DisplayTopic is called by the Help Manager if a Help Viewer claims

  in its response to UnderstandsTopic to be able to provide Topic-based

  help for a particular keyword. }

 

procedure THTMLHelpViewer.DisplayTopic(const Topic: String);

var

  HelpCommand: array[0..255of Char;

begin

  StrLFmt(HelpCommand, SizeOf(HelpCommand) -1'%s', [Topic + 'zzz']);

 

  { The Fix!! }

  Self.HelpCommand_HELP_SETPOPUP_POS;

  Application.HelpCommand(HELP_KEY, Longint(@HelpCommand));

end;

 

 

{ UnderstandsContext is a querying function called by the Help Manager

  to determine if an Extended Help Viewer is capable of providing

  help for a particular context-ID. }

 

function THTMLHelpViewer.UnderstandsContext(const ContextID: Integer;

                                           const HelpFileName: String): Boolean;

begin

  Result := true;

end;

 

 

{ DisplayHelpByContext is used by the Help Manager to request that a

  Help Viewer display help for a particular Context-ID. }

 

procedure THTMLHelpViewer.DisplayHelpByContext(const ContextID: Integer; const HelpFileName: String);

var SaveWinHelpTester: IWinHelpTester;

begin

  { The Fix!! }

  Self.HelpCommand_HELP_SETPOPUP_POS;

  { 9-Jan-2003: Stop recursion by saving state}

  SaveWinHelpTester := WinHelpViewer.WinHelpTester;

  WinHelpViewer.WinHelpTester := nil;

    Application.HelpCommand(HELP_CONTEXT, ContextID);

  WinHelpViewer.WinHelpTester := SaveWinHelpTester;

end;

 

{ Uses this function to enable or disable WinHelpViewer.WinHelpTester.

  WinHelpTester is enabled when you use this module (viewer 2). It

  is used to stop Viewer 1 being favoured by the HelpManager.

  If you need to call a WinHelp function (viewer 1 needed) then

  you would need to disable winhelptester for that call.

  See Delphi source WinHelpViewer.pas for where WinHelpTester is used.

 

  Note: WinHelpTester is set to Nil by WinHelpViewer cleanup

}

procedure WinHelpTester_Enable(aEnable: Boolean);

begin

  {Enable WinHelpTester - ie. Make HelpManager use this viewer}

  if aEnable then begin

    if not Assigned(WinHelpViewer.WinHelpTester) then

      WinHelpViewer.WinHelpTester := TWinHelpTester.Create;

  end

  {Disable WinHelpTester - ie. Make HelpManager use WinHelpViewer again}

  else begin

    if Assigned(WinHelpViewer.WinHelpTester) then

      WinHelpViewer.WinHelpTester := Nil;

  end;

end;

 

function AbrirHelpContext(const IDContext: Cardinal): Boolean;

begin

  HtmlHelpA(Screen.ActiveForm.Handle, PChar(HelpCHM_Arquivo), $F, IDContext);

  Result := True;

end;

 

initialization

 

  WinHelpTester_Enable(true);

  HelpSelector := THelpSelector.Create;                  //set to Nil by HelpIntfs cleanup

  HelpViewer := THTMLHelpViewer.Create;

  Application.HelpSystem.AssignHelpSelector(HelpSelector);

  HelpIntfs.RegisterViewer(HelpViewer {ICustomHelpViewer}, HelpViewer.FHelpManager {IHelpManager});

  LoadHtmlHelp;

 

finalization

 

  UnloadHtmlHelp;

  HelpSelector._Release;   //RWC_RELEASE

  if Assigned(HelpViewer.FHelpManager) then

    HelpViewer.InternalShutDown;

 

end.