paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 15:56:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

chmhelp: added components and example to load chm files in LCL applications

Browse Source 
git-svn-id: trunk@37982 -
This commit is contained in:
mattias 2012-07-20 11:52:08 +00:00
parent 40fd2c1745
commit c582332a32
8 changed files with 630 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -383,6 +383,10 @@ components/anchordocking/minide/simplefrm.pas svneol=native#text/plain
components/anchordocking/minide/unit1.lfm svneol=native#text/plain
components/anchordocking/minide/unit1.pas svneol=native#text/plain
components/chmhelp/README.txt svneol=native#text/plain
components/chmhelp/democontrol/ContextHelpDemo.lpi svneol=native#text/plain
components/chmhelp/democontrol/ContextHelpDemo.lpr svneol=native#text/plain
components/chmhelp/democontrol/ctxchmhelpunit1.lfm svneol=native#text/plain
components/chmhelp/democontrol/ctxchmhelpunit1.pas svneol=native#text/plain
components/chmhelp/democontrol/helpconnectionunit1.lfm svneol=native#text/plain
components/chmhelp/democontrol/helpconnectionunit1.pas svneol=native#text/plain
components/chmhelp/democontrol/lhelpconnectiondemo1.lpi svneol=native#text/plain
@ -413,6 +417,7 @@ components/chmhelp/lhelp/lnethttpdataprovider.pas svneol=native#text/plain
components/chmhelp/packages/help/Makefile svneol=native#text/plain
components/chmhelp/packages/help/Makefile.compiled svneol=native#text/plain
components/chmhelp/packages/help/Makefile.fpc svneol=native#text/plain
components/chmhelp/packages/help/lazhelpchm.pas svneol=native#text/plain
components/chmhelp/packages/help/lhelpcontrol.pas svneol=native#text/plain
components/chmhelp/packages/help/lhelpcontrolpkg.lpk svneol=native#text/plain
components/chmhelp/packages/help/lhelpcontrolpkg.pas svneol=native#text/plain

92
components/chmhelp/democontrol/ContextHelpDemo.lpi Normal file
View File

@ -0,0 +1,92 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<Title Value="ContextHelpDemo"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="lhelpcontrolpkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="ContextHelpDemo.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ContextHelpDemo"/>
</Unit0>
<Unit1>
<Filename Value="ctxchmhelpunit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="CtxCHMHelpUnit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="ContextHelpDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

20
components/chmhelp/democontrol/ContextHelpDemo.lpr Normal file
View File

@ -0,0 +1,20 @@
program ContextHelpDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, ctxchmhelpunit1, lhelpcontrolpkg;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

54
components/chmhelp/democontrol/ctxchmhelpunit1.lfm Normal file
View File

@ -0,0 +1,54 @@
object Form1: TForm1
Left = 545
Height = 239
Top = 193
Width = 359
Caption = 'Form1'
ClientHeight = 239
ClientWidth = 359
OnCreate = FormCreate
LCLVersion = '1.1'
object Edit1: TEdit
Left = 71
Height = 22
Top = 72
Width = 225
HelpType = htKeyword
HelpKeyword = 'example/MainPage.html'
TabOrder = 0
Text = 'Edit1'
end
object Edit2: TEdit
Left = 71
Height = 22
Top = 128
Width = 224
HelpType = htKeyword
HelpKeyword = 'example/SecondPage.html'
TabOrder = 1
Text = 'Edit2'
end
object ShowHelpButton: TButton
Left = 70
Height = 20
Top = 20
Width = 128
AutoSize = True
Caption = 'ShowHelpButton'
OnClick = ShowHelpButtonClick
TabOrder = 2
end
object CHMHelpDatabase1: TCHMHelpDatabase
AutoRegister = True
Filename = '../../../tools/chmmaker/example.chm'
KeywordPrefix = 'example/'
left = 80
top = 168
end
object LHelpConnector1: TLHelpConnector
LHelpPath = '../lhelp/lhelp'
AutoRegister = True
left = 256
top = 168
end
end

87
components/chmhelp/democontrol/ctxchmhelpunit1.pas Normal file
View File

@ -0,0 +1,87 @@
{
Abstract:
This example demonstrates the chm help components.
TCHMLHelpDatabase handles help for a single chm file - it contains the
mapping from Keyword to page.
TLHelpConnector starts "lhelp" a chm viewer written in pure pascal.
How was the example created:
Put a TCHMHelpDatabase on a form.
Set AutoRegister to true.
Set KeywordPrefix to 'example/'
Set Filename to the path of the chm file '../../../tools/chmaker/example.chm'
You can create the example.chm with chmmaker (see the REDAME.txt
in the chmmaker directory).
Put a TLHelpConnector on the form.
Set AutoRegister to true.
Set LHelpPath to '../lhelp/lhelp'.
Put a TEdit on a form.
Set HelpType to htKeyword
Set HelpKeyword to 'example/MainPage.html'
Run the program.
Focus the edit field and press F1. lhelp will be started. lhelp will load
example.chm and show the page MainPage.html.
}
unit CtxCHMHelpUnit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
HelpIntfs, LazHelpIntf, LazHelpCHM;
const
{$IFDEF Darwin}
HelpShortcut = #$e2#$8c#$98'?';
{$ELSE}
HelpShortcut = 'F1'';
{$ENDIF}
type
{ TForm1 }
TForm1 = class(TForm)
CHMHelpDatabase1: TCHMHelpDatabase;
Edit1: TEdit;
Edit2: TEdit;
LHelpConnector1: TLHelpConnector;
ShowHelpButton: TButton;
procedure FormCreate(Sender: TObject);
procedure ShowHelpButtonClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateLCLHelpSystem;
Edit1.Text:='Edit1 - Press '+HelpShortcut+' for help';
Edit2.Text:='Edit2 - Press '+HelpShortcut+' for help';
end;
procedure TForm1.ShowHelpButtonClick(Sender: TObject);
begin
// This demonstrates how to show a help item manually:
ShowHelpOrErrorForKeyword('','example/AboutLazarus.html');
end;
{$R *.lfm}
end.

355
components/chmhelp/packages/help/lazhelpchm.pas Normal file
View File

@ -0,0 +1,355 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
Methods and types for simple CHM help using chm viewer "lhelp".
}
unit LazHelpCHM;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazHelpIntf, LazConfigStorage, HelpIntfs,
Dialogs, Forms, LazLogger, FileUtil, LHelpControl;
const
CHMMimeType = 'application/chm';
CHMPathParam = 'path';
type
{ TCHMHelpDatabase
KeywordPrefix: if set, then the database will handle all Keywords
beginning with this value. And when the path is created by replacing
the prefix with the BaseURL.
For example:
Create a chm. For example build and run chmmaker in lazarus/tools/chmmaker
to create the example.chm (lazarus/tools/chmmaker/example.chm).
Put a TCHMHelpDatabase on a form.
Set AutoRegister to true.
Set KeywordPrefix to 'example/'
Set CHM file to '../../../tools/chmmaker/example.chm'
Put a TLHelpRemoteViewer on the form.
Set AutoRegister to true.
Set LHelpPath to the path of lhelp. E.g. '../../lhelp/lhelp'
Put a TEdit on a form.
Set HelpType to htKeyword
Set HelpKeyword to 'example/MainPage.html'
Run the program.
Focus the edit field and press F1. The page 'MainPage.html' will be shown.
}
TCHMHelpDatabase = class(THelpDatabase)
private
FFilename: string;
FHelpNode: THelpNode;
FKeywordPrefix: string;
procedure SetFilename(AValue: string);
procedure SetKeywordPrefix(AValue: string);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function ShowHelp({%H-}Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode;
{%H-}QueryItem: THelpQueryItem;
var ErrMsg: string): TShowHelpResult; override;
function ShowURL(const URL, Title: string;
var ErrMsg: string): TShowHelpResult; virtual;
function GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; override;
procedure Load(Storage: TConfigStorage); override;
procedure Save(Storage: TConfigStorage); override;
published
property AutoRegister;
property Filename: string read FFilename write SetFilename;
property KeywordPrefix: string read FKeywordPrefix write SetKeywordPrefix;
end;
type
TOnFindLHelp = procedure(var Path: string) of object;
{ TLHelpConnector }
TLHelpConnector = class(THelpViewer)
private
FConnection: TLHelpConnection;
FLHelpPath: string;
FOnFindLHelp: TOnFindLHelp;
procedure SetLHelpPath(AValue: string);
public
constructor Create(TheOwner: TComponent); override;
function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override;
procedure Assign(Source: TPersistent); override;
procedure Load(Storage: TConfigStorage); override;
procedure Save(Storage: TConfigStorage); override;
function GetLocalizedName: string; override;
property OnFindLHelp: TOnFindLHelp read FOnFindLHelp write FOnFindLHelp;
property Connection: TLHelpConnection read FConnection;
published
property LHelpPath: string read FLHelpPath write SetLHelpPath;
property AutoRegister;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('System',[TCHMHelpDatabase,TLHelpConnector]);
end;
{ TLHelpConnector }
procedure TLHelpConnector.SetLHelpPath(AValue: string);
begin
if FLHelpPath=AValue then Exit;
FLHelpPath:=AValue;
end;
constructor TLHelpConnector.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
AddSupportedMimeType(CHMMimeType);
end;
function TLHelpConnector.ShowNode(Node: THelpNode; var ErrMsg: string
): TShowHelpResult;
var
Path: String;
IPCFile: String;
URLScheme: string;
URLPath: string;
URLParams: string;
CHMFilename: String;
SubPath: String;
Response: TLHelpResponse;
s: String;
begin
debugln(['TLHelpConnector.ShowNode START URL="',Node.URL,'"']);
Result:=shrViewerError;
ErrMsg:='';
if (not Node.URLValid) then begin
ErrMsg:='TLHelpConnector.ShowNode Node.URLValid=false';
exit;
end;
if (Node.URL='') then begin
ErrMsg:='TLHelpConnector.ShowNode Node.URL empty';
exit;
end;
SplitURL(Node.URL,URLScheme,URLPath,URLParams);
CHMFilename:=SetDirSeparators(URLPath);
if not FileExistsUTF8(CHMFilename) then begin
ErrMsg:='chm file "'+CHMFilename+'" not found';
exit;
end;
SubPath:='';
if LeftStr(URLParams,length(CHMPathParam)+1)=CHMPathParam+'=' then begin
SubPath:=URLParams;
Delete(SubPath,1,length(CHMPathParam)+1);
end;
if Connection=nil then begin
// create a connection to lhelp:
FConnection := TLHelpConnection.Create;
Connection.ProcessWhileWaiting := @Application.ProcessMessages;
end;
if Connection.ServerRunning = false then begin
IPCFile:=ExtractFileName(Application.ExeName);
IPCFile+='lhelpconnector';
{$IFDEF Unix}
if FileExistsUTF8('/tmp/'+IPCFile) then
DeleteFileUTF8('/tmp/'+IPCFile);
{$ENDIF}
// get lhelp path
Path:=LHelpPath;
if Assigned(OnFindLHelp) then
OnFindLHelp(Path);
// append exe extension
if (ExtractFileExt(Path)='') and (GetExeExt<>'') then
Path:=Path+GetExeExt;
// search in Path
if (Path<>'') and (ExtractFilePath(Path)='') then begin
s:=FindDefaultExecutablePath(Path);
if s<>'' then Path:=s;
end;
{$IFDEF darwin}
// search exe in application bundle
if DirectoryExistsUTF8(Path+'.app') then
Path:=Path+'.app/Contents/MacOS/'+ExtractFileName(Path);
{$ENDIF}
if not FileExistsUTF8(Path) then begin
ErrMsg:='The chm viewer program lhelp was not found at "'+Path+'"';
exit;
end;
Connection.StartHelpServer(IPCFile,Path);
end;
Response:=Connection.OpenURL(CHMFilename,SubPath);
case Response of
srSuccess: exit(shrSuccess);
srNoAnswer: ErrMsg:='lhelp does not respond';
srInvalidFile: ErrMsg:='lhelp can not open the file "'+CHMFilename+'"';
srInvalidURL,srInvalidContext: ErrMsg:='lhelp can not find the help entry "'+SubPath+'"';
else
ErrMsg:='Something is wrong with lhelp';
end;
end;
procedure TLHelpConnector.Assign(Source: TPersistent);
var
Src: TLHelpConnector;
begin
if Source is TLHelpConnector then begin
Src:=TLHelpConnector(Source);
LHelpPath:=Src.LHelpPath;
end;
inherited Assign(Source);
end;
procedure TLHelpConnector.Load(Storage: TConfigStorage);
begin
inherited Load(Storage);
LHelpPath:=Storage.GetValue('LHelp/Path','');
end;
procedure TLHelpConnector.Save(Storage: TConfigStorage);
begin
inherited Save(Storage);
Storage.SetDeleteValue('LHelp/Path',LHelpPath,'');
end;
function TLHelpConnector.GetLocalizedName: string;
begin
Result:='LHelp Connector';
end;
{ TCHMHelpDatabase }
procedure TCHMHelpDatabase.SetFilename(AValue: string);
begin
if FFilename=AValue then Exit;
FFilename:=AValue;
end;
procedure TCHMHelpDatabase.SetKeywordPrefix(AValue: string);
begin
if FKeywordPrefix=AValue then Exit;
FKeywordPrefix:=AValue;
end;
constructor TCHMHelpDatabase.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
AddSupportedMimeType(CHMMimeType);
end;
destructor TCHMHelpDatabase.Destroy;
begin
FreeAndNil(FHelpNode);
inherited Destroy;
end;
function TCHMHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
): TShowHelpResult;
begin
ErrMsg:='';
Result:=shrContextNotFound;
if NewNode.URLValid then begin
Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg);
end else begin
Result:=shrContextNotFound;
ErrMsg:='TCHMHelpDatabase.ShowHelp Node.URLValid=false Node.URL="'+NewNode.URL+'"';
end;
end;
function TCHMHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string
): TShowHelpResult;
var
Viewer: THelpViewer;
Node: THelpNode;
begin
//DebugLn('TCHMHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"');
if not FileExistsUTF8(Filename) then begin
ErrMsg:='chm help file "'+Filename+'" not found';
exit(shrDatabaseNotFound);
end;
// find HTML viewer
Result:=FindViewer(CHMMimeType,ErrMsg,Viewer);
if Result<>shrSuccess then exit;
// call viewer
Node:=nil;
try
Node:=THelpNode.CreateURL(Self,Title,URL);
Result:=Viewer.ShowNode(Node,ErrMsg);
finally
Node.Free;
end;
end;
function TCHMHelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
var
Path: String;
begin
Result:=inherited GetNodesForKeyword(HelpKeyword, ListOfNodes, ErrMsg);
if Result<>shrSuccess then exit;
if not (csDesigning in ComponentState)
and (KeywordPrefix<>'')
and (LeftStr(HelpKeyword,length(KeywordPrefix))=KeywordPrefix) then begin
// HelpKeyword starts with KeywordPrefix -> add default node
if FHelpNode=nil then
FHelpNode:=THelpNode.CreateURL(Self,'','');
Path:=copy(HelpKeyword,length(KeywordPrefix)+1,length(HelpKeyword));
FHelpNode.Title:='Show page '+Path+' of '+ExtractFileName(Filename);
FHelpNode.URL:='chmfile://'+FilenameToURLPath(Filename)+'?'+CHMPathParam+'='+Path;
CreateNodeQueryListAndAdd(FHelpNode,nil,ListOfNodes,true);
end;
end;
procedure TCHMHelpDatabase.Load(Storage: TConfigStorage);
begin
inherited Load(Storage);
KeywordPrefix:=Storage.GetValue('KeywordPrefix','');
Filename:=Storage.GetValue('Filename','');
end;
procedure TCHMHelpDatabase.Save(Storage: TConfigStorage);
begin
inherited Save(Storage);
Storage.SetDeleteValue('KeywordPrefix',KeywordPrefix,'');
Storage.SetDeleteValue('Filename',Filename, '');
end;
end.

8
components/chmhelp/packages/help/lhelpcontrolpkg.lpk
View File

@ -21,12 +21,18 @@
<Description Value="This package contains unit that will allow you to &quot;remote control&quot; the program LHelp."/>
<License Value="Modified LGPL-2, same as LCL"/>
<Version Minor="2"/>
<Files Count="1">
<Files Count="2">
<Item1>
<Filename Value="lhelpcontrol.pas"/>
<UnitName Value="LHelpControl"/>
</Item1>
<Item2>
<Filename Value="lazhelpchm.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="LazHelpCHM"/>
</Item2>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>

13
components/chmhelp/packages/help/lhelpcontrolpkg.pas
View File

@ -1,14 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
This source is only used to compile and install the package.
}
unit lhelpcontrolpkg;
unit lhelpcontrolpkg;
interface
uses
LHelpControl;
LHelpControl, LazHelpCHM, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('LazHelpCHM', @LazHelpCHM.Register);
end;
initialization
RegisterPackage('lhelpcontrolpkg', @Register);
end.