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

LHelp: Revamp. Issue #38250, patch from Andrey Sobol.

Browse Source 
git-svn-id: trunk@64510 -
This commit is contained in:
juha 2021-02-08 20:53:44 +00:00
parent b944f49922
commit 08eb6e34a9
25 changed files with 1823 additions and 742 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/chmhelp/lhelp/Makefile.fpc
View File

@ -24,6 +24,7 @@ unitdir=. $(LAZDIR)/components/lazutils/lib/$(CPU_TARGET)-$(OS_TARGET) \
$(LAZDIR)/components/cairocanvas/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) \
$(LAZDIR)/components/turbopower_ipro/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) \
$(LAZDIR)/components/printers/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) \
$(LAZDIR)/components/mouseandkeyinput/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) \
../packages/help/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM)
targetdir=.

152
components/chmhelp/lhelp/basecontentprovider.pas
View File

@ -5,7 +5,11 @@ unit BaseContentProvider;
interface
uses
Classes, SysUtils, Controls, Laz2_XMLCfg;
Classes, SysUtils,
// LCL
Controls,
// LazUtils
Laz2_XMLCfg, LazLoggerBase;
type
@ -15,7 +19,8 @@ type
TBaseContentProvider = class(TObject)
private
FOnTitleChange: TNotifyEvent;
fParent: TWinControl;
FOnContentComplete: TNotifyEvent;
FParent: TWinControl;
FTitle: String;
FConfig: TXMLConfig;
FUpdateCount: Integer;
@ -23,37 +28,46 @@ type
fImageList: TImageList;
function GetTitle: String; virtual;
procedure SetTitle(const AValue: String); virtual;
function IsUpdating: Boolean;
function isUpdate: Boolean;
function isUpdateLast: Boolean;
public
function CanGoBack: Boolean; virtual; abstract;
function CanGoForward: Boolean; virtual; abstract;
function GetHistory: TStrings; virtual; abstract;
function LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; virtual; abstract;
function HasLoadedData(const {%H-}AURL: String): Boolean; virtual;
procedure GoHome; virtual; abstract;
procedure GoBack; virtual; abstract;
procedure GoForward; virtual; abstract;
procedure ActivateProvider; virtual;
procedure ActivateTOCControl; virtual; abstract;
procedure ActivateIndexControl; virtual; abstract;
procedure ActivateSearchControl; virtual; abstract;
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
procedure LoadPreferences(ACfg: TXMLConfig); virtual;
procedure SavePreferences({%H-}ACfg: TXMLConfig); virtual;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract;
constructor Create(AParent: TWinControl; AImageList: TImageList); virtual;
constructor Create(AParent: TWinControl; AImageList: TImageList; AUpdateCount: Integer); virtual;
destructor Destroy; override;
property Parent: TWinControl read fParent;
property Title: String read GetTitle write SetTitle;
property OnTitleChange: TNotifyEvent read FOnTitleChange write FOnTitleChange;
property OnContentComplete: TNotifyEvent read FOnContentComplete write FOnContentComplete;
end;
function GetUriPrefix( const AUri: String ):String;
function GetUrlFilePath ( const AUri: String ) : String;
function GetURIURL( const AURI: String): String;
function GetURIFileName( const AURI: String): String;
function GetUrlFile( const AUrl:String): String;
function GetUrlWoContext( const AUrl:String): String;
// returns false if the protocol has already been registered
function RegisterContentProvider(const Protocol: String; ContentProvider: TBaseContentProviderClass): Boolean;
// example: RegisterContentProvider('chm://', TChmContentProvider);
function RegisterContentProviderClass(const Protocol: String; ContentProvider: TBaseContentProviderClass): Boolean;
// example: RegisterContentProvider('file://', TChmContentProvider);
function GetContentProvider(const Protocol: String): TBaseContentProviderClass;
// Result must be freed by caller
function GetContentProviderList: TStringList;
implementation
@ -61,12 +75,80 @@ implementation
var
ContentProviders: TStringList;
function RegisterContentProvider(const Protocol: String;
function GetUriPrefix ( const AUri: String ) : String;
var
fPos: Integer;
begin
Result := Trim(AUri);
fPos := Pos('://', Result);
if fPos >0 Then
Result := Copy(Result, 1, fPos+2);
end;
function GetUrlFilePath ( const AUri: String ) : String;
var
fPos: Integer;
begin
Result := Copy(AUri,Length(GetUriPrefix(AUri))+1, Length(AUri));
fPos := Pos('://', Result);
if fPos > 0 then
Result := Copy(Result, 1, fPos-1);
fPos := Pos('?', Result);
if fPos > 0 then
Result := Copy(Result, 1, fPos-1);
end;
function GetURIFileName(Const AURI: String): String;
var
FileStart,
FileEnd: Integer;
begin
FileStart := Pos(':', AURI)+1;
FileEnd := Pos('::', AURI);
Result := Copy(AURI, FileStart, FileEnd-FileStart);
end;
function GetUrlFile(const AUrl: String): String;
var
fPos: Integer;
begin
Result := Copy(AUrl,Length(GetUriPrefix(AUrl)), Length(AUrl));
fPos := Pos('://', Result);
if fPos > 0 then
Result := Copy(Result, fPos+3, Length(Result))
else
Result:= '';
end;
function GetUrlWoContext(const AUrl: String): String;
var
fPos: Integer;
begin
Result:= AUrl;
fPos := Pos('?', Result);
if fPos > 0 then
Result := Copy(Result, 1, fPos-1);
fPos := Pos('#', Result);
if fPos > 0 then
Result := Copy(Result, 1, fPos-1);
end;
function GetURIURL(Const AURI: String): String;
var
URLStart: Integer;
begin
URLStart := Pos('::', AURI) + 2;
Result := Copy(AURI, URLStart, Length(AURI));
end;
function RegisterContentProviderClass(const Protocol: String;
ContentProvider: TBaseContentProviderClass): Boolean;
begin
Result := False;
if ContentProviders.IndexOf(Protocol) > -1 then exit;
ContentProviders.AddObject(Protocol, TObject(ContentProvider));
if GetContentProviderList.IndexOf(Protocol) > -1 then exit;
GetContentProviderList.AddObject(Protocol, TObject(ContentProvider));
Result := true;
end;
function GetContentProvider(const Protocol: String): TBaseContentProviderClass;
@ -74,20 +156,18 @@ var
fIndex: Integer;
begin
Result := nil;
fIndex := ContentProviders.IndexOf(Protocol);
fIndex := GetContentProviderList.IndexOf(Protocol);
if fIndex = -1 then Exit;
Result := TBaseContentProviderClass(ContentProviders.Objects[fIndex]);
Result := TBaseContentProviderClass(GetContentProviderList.Objects[fIndex]);
end;
function GetContentProviderList: TStringList;
begin
Result := TStringList.Create;
Result.AddStrings(ContentProviders);
if ContentProviders = nil then // Singleton
ContentProviders := TStringList.Create;
Result := ContentProviders;
end;
{ TBaseContentProvider }
function TBaseContentProvider.GetTitle: String;
@ -102,14 +182,32 @@ begin
FOnTitleChange(Self);
end;
function TBaseContentProvider.IsUpdating: Boolean;
function TBaseContentProvider.isUpdate: Boolean;
begin
Result := FUpdateCount <> 0;
end;
function TBaseContentProvider.isUpdateLast: Boolean;
begin
Result := FUpdateCount <= 1;
end;
function TBaseContentProvider.HasLoadedData ( const AURL: String ) : Boolean;
begin
Result:= false;
end;
procedure TBaseContentProvider.ActivateProvider;
begin
//
end;
procedure TBaseContentProvider.BeginUpdate;
begin
Inc(FUpdateCount);
{$IFDEF UPDATE_CNT}
DebugLn('BeginUpdate() Cnt: ', IntToStr(FUpdateCount));
{$ENDIF}
end;
procedure TBaseContentProvider.EndUpdate;
@ -117,6 +215,9 @@ begin
Dec(FUpdateCount);
if FUpdateCount < 0 then
FUpdateCount:=0;
{$IFDEF UPDATE_CNT}
DebugLn('EndUpdate() Cnt: ', IntToStr(FUpdateCount));
{$ENDIF}
end;
procedure TBaseContentProvider.LoadPreferences(ACfg: TXMLConfig);
@ -129,10 +230,12 @@ begin
end;
constructor TBaseContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
constructor TBaseContentProvider.Create(AParent: TWinControl;
AImageList: TImageList; AUpdateCount: Integer);
begin
fParent:= AParent;
fImageList:= AImageList;
FParent:= AParent;
FImageList:= AImageList;
FUpdateCount:= AUpdateCount;
end;
destructor TBaseContentProvider.Destroy;
@ -142,7 +245,6 @@ begin
end;
initialization
ContentProviders := TStringList.Create;
finalization

874
components/chmhelp/lhelp/chmcontentprovider.pas
View File

File diff suppressed because it is too large Load Diff

125
components/chmhelp/lhelp/chmdataprovider.pas
View File

@ -14,36 +14,38 @@ unit ChmDataProvider;
interface
uses
Classes, SysUtils, IpHtml, iputils, IpMsg, Graphics, chmreader,
LCLType, Controls,
FPImage,
{$IF FPC_FULLVERSION>=20602} //fpreadgif exists since at least this version
FPReadgif,
{$ENDIF}
FPReadbmp,
FPReadxpm,
FPReadJPEG,
FPReadpng,
FPWritebmp,
Classes, SysUtils, chmreader,
FPImage, FPReadgif, FPReadbmp, FPReadxpm, FPReadJPEG, FPReadpng, FPWritebmp,
FPWritePNG,
IntFGraphics,
lhelpstrconsts;
// LCL
Graphics, LCLType, Controls, IntFGraphics,
// LazUtils
LazFileUtils, LazLoggerBase,
// Turbopower IPro
IpHtml, iputils, IpMsg,
// ChmHelp
LHelpStrConsts;
type
THelpPopupEvent = procedure(HelpFile: String; URL: String);
THtmlPageLoadStreamEvent = procedure (var AStream: TStream) of object;
{ TCHMFileListPublic }
TCHMFileListPublic = class(TChmFileList)
end;
{ TIpChmDataProvider }
TIpChmDataProvider = class(TIpAbstractHtmlDataProvider)
private
fChm: TChmFileList;
fChms: TCHMFileListPublic;
fCurrentPage: String;
fCurrentPath: String;
FOnGetHtmlPage: THtmlPageLoadStreamEvent;
fOnHelpPopup: THelpPopupEvent;
function GetChms: TChmFileList;
function StripInPageLink(AURL: String): String;
protected
function DoGetHtmlStream(const URL: string;
@ -59,15 +61,16 @@ type
function GetDirsParents(ADir: String): TStringList;
function DoGetStream(const URL: string): TStream; override;
public
constructor Create(AOwner: TComponent; AChm: TChmFileList); reintroduce;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetHtmlText(AURL: String): RawByteString;
property Chm: TChmFileList read fChm write fChm;
property Chms: TChmFileList read GetChms;
procedure DoOpenChm ( const AFile: String; ACloseCurrent: Boolean );
procedure DoCloseChms;
property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup;
property CurrentPage: String read fCurrentPage;
property CurrentPath: String read fCurrentPath write fCurrentPath;
property OnGetHtmlPage: THtmlPageLoadStreamEvent read FOnGetHtmlPage write FOnGetHtmlPage;
end;
implementation
@ -84,7 +87,12 @@ begin
Result := Copy(Result, 1, i-1);
end;
function TIpChmDataProvider.GetHtmlText(AURL: string): RawByteString;
function TIpChmDataProvider.GetChms: TChmFileList;
begin
Result:= fChms;
end;
function TIpChmDataProvider.GetHtmlText ( AURL: String ) : RawByteString;
var
stream: TStream;
ms: TMemoryStream;
@ -100,7 +108,7 @@ begin
// --> buffer to memory stream
ms := TMemoryStream.Create;
try
ms.CopyFrom(stream, stream.Size);
ms.CopyFrom(stream, 0);
SetLength(Result, ms.Size);
Move(ms.Memory^, Result[1], ms.Size);
finally
@ -112,20 +120,41 @@ begin
end;
end;
procedure TIpChmDataProvider.DoOpenChm ( const AFile: String;
ACloseCurrent: Boolean ) ;
begin
if fChms.IsAnOpenFile(AFile) then Exit;
if ACloseCurrent then DoCloseChms;
if not FileExistsUTF8(AFile) or DirectoryExistsUTF8(AFile) then
Exit;
TCHMFileListPublic(fChms).OpenNewFile(AFile);
// Code for Indexes has been moved to the OpenFile handler
end;
procedure TIpChmDataProvider.DoCloseChms;
begin
if assigned(fChms) then
while Chms.Count > 0 do fChms.Delete(0);
end;
function TIpChmDataProvider.DoGetHtmlStream(const URL: string;
PostData: TIpFormDataEntity): TStream;
var Tmp:string;
var
Msg:string;
begin
Result := fChm.GetObject(StripInPageLink(URL));
//WriteLn('DoGetHtmlStream() Url: ', URL);
Result := fChms.GetObject(StripInPageLink(URL));
// If for some reason we were not able to get the page return something so that
// we don't cause an AV
if Result = nil then begin
Result := TMemoryStream.Create;
Tmp := '<HTML>' + slhelp_PageCannotBeFound + '</HTML>';
Result.Write(Tmp,Length(tmp));
Msg := '<html><span align="center">' + slhelp_PageCannotBeFound + '</span></html>';
Result.Write(Pointer(Msg)^, Length(Msg));
end;
Result.Position:= 0;
if Assigned(FOnGetHtmlPage) then
FOnGetHtmlPage(Result);
Result.Position:= 0;
end;
function TIpChmDataProvider.DoCheckURL(const URL: string;
@ -133,26 +162,27 @@ function TIpChmDataProvider.DoCheckURL(const URL: string;
var
Reader: TChmReader = nil;
begin
//DebugLn('RequestedUrl: ',URL);
Result := fChm.ObjectExists(StripInPageLink(Url), Reader) > 0;
Result:= true;
//DebugLn('CD DoCheckURL() Url: ', URL);
Result := fChms.ObjectExists(StripInPageLink(Url), Reader) > 0;
if Result then begin
ContentType := 'text/html';
fCurrentPath := ExtractFilePath(Url);
Result := True;
fCurrentPage := URL;
//DebugLn('CD checked url: ', URL);
end;
end;
procedure TIpChmDataProvider.DoLeave(Html: TIpHtml);
begin
//
// //DebugLn('Left: ');
// For free a data resources
//DebugLn('CD Left: ');
end;
procedure TIpChmDataProvider.DoReference(const URL: string);
begin
//
////DebugLn('Reference=',URL);
// For get all references from document
// DebugLn('CD Reference=',URL);
end;
procedure TIpChmDataProvider.DoGetImage(Sender: TIpHtmlNode; const URL: string;
@ -161,13 +191,11 @@ var
Stream: TMemoryStream;
FileExt: String;
begin
//DebugLn('Getting Image ',(Url));
Picture := nil;
//DebugLn('CD Getting Image ',(Url));
FileExt := ExtractFileExt(URL);
Picture := TPicture.Create;
Stream := fChm.GetObject('/'+URL);
Stream := fChms.GetObject('/'+URL);
try
if Assigned(Stream) then
begin
@ -185,20 +213,19 @@ function TIpChmDataProvider.CanHandle(const URL: string): Boolean;
var
Reader: TChmReader = nil;
begin
Result := True;
//DebugLn('CD CanHandle() Url: ', URL);
Result:=True;
if Pos('Java', URL) = 1 then
Result := False;
if (fChm.ObjectExists(StripInPageLink(url), Reader)= 0) and
(fChm.ObjectExists(StripInPageLink(BuildUrl(fCurrentPath,Url)), Reader) = 0)
// Here is opened the new chm file if required
if (fChms.ObjectExists(StripInPageLink(url), Reader)= 0) and
(fChms.ObjectExists(StripInPageLink(BuildUrl(fCurrentPath,Url)), Reader) = 0)
then
Result := False;
//DebugLn('CanHandle ',Url,' = ', Result);
//if not Result then if fChm.ObjectExists(BuildURL('', URL)) > 0 Then result := true;
if (not Result) and (Pos('#', URL) = 1) then
Result := True;
//DebugLn('CD CanHandle() ResultUrl: ', Result);
end;
function TIpChmDataProvider.BuildURL(const OldURL, NewURL: string): string;
@ -255,8 +282,8 @@ begin
finally
ParentDirs.Free;
//WriteLn('res = ', Result);
end;
//DebugLn('CD BuildURL() Url: ', Result);
end;
function TIpChmDataProvider.GetDirsParents(ADir: String): TStringList;
@ -279,6 +306,7 @@ function TIpChmDataProvider.DoGetStream(const URL: string): TStream;
var
NewURL: String;
begin
//DebugLn('CD DoGetStream() Url: ', URL);
Result := nil;
if Length(URL) = 0 then
Exit;
@ -286,18 +314,21 @@ begin
NewURL := BuildUrl(fCurrentPath,URL)
else
NewURL := URL;
Result := fChm.GetObject(NewURL);
Result := fChms.GetObject(NewURL);
if Result <> nil then Result.Position:= 0;
//if Result = nil then DebugLn('CD Err DoGetStream URL: '+URL);
end;
constructor TIpChmDataProvider.Create(AOwner: TComponent; AChm: TChmFileList);
constructor TIpChmDataProvider.Create ( AOwner: TComponent ) ;
begin
inherited Create(AOwner);
fChm := AChm;
fChms := TCHMFileListPublic.Create('');
end;
destructor TIpChmDataProvider.Destroy;
begin
DoCloseChms;
FreeAndnil(fChms);
inherited Destroy;
end;

67
components/chmhelp/lhelp/chmspecialparser.pas
View File

@ -42,10 +42,11 @@ type
fBranchCount: DWord;
fStop: PBoolean;
fLastNode: TTreeNode;
procedure AddItem(AItem: TChmSiteMapItem; AParentNode: TTreeNode);
procedure AddSiteMapItem(AItem: TChmSiteMapItem; AParentNode: TTreeNode; ANextNode: TTreeNode);
public
constructor Create(ATreeView: TTreeView; ASitemap: TChmSiteMap; StopBoolean: PBoolean; AChm: TObject);
procedure DoFill(ParentNode: TTreeNode);
destructor Destroy; override;
procedure DoFill(ParentNode: TTreeNode; ASortRoot: Boolean);
end;
implementation
@ -87,7 +88,7 @@ begin
else
begin // ';' was found, this may be an HTML entity like "&xxx;".
AmpStr := Copy(AText, AmpPos+1, i-AmpPos-1);
ws := UTF8Encode(AmpStr);
ws := UTF8ToUTF16(UTF8Encode(AmpStr));
if ResolveHTMLEntityReference(ws, Entity) then
Result := Result + UnicodeToUTF8(cardinal(Entity))
else
@ -120,7 +121,8 @@ end;
{ TContentsFiller }
procedure TContentsFiller.AddItem(AItem: TChmSiteMapItem; AParentNode: TTreeNode);
procedure TContentsFiller.AddSiteMapItem(AItem: TChmSiteMapItem;
AParentNode: TTreeNode; ANextNode: TTreeNode);
var
NewNode: TContentTreeNode;
X: Integer;
@ -135,7 +137,10 @@ begin
begin
// Add new child node
fLastNode := AParentNode;
NewNode := TContentTreeNode(fTreeView.Items.AddChild(AParentNode, txt));
if Assigned(ANextNode) then
NewNode := TContentTreeNode(fTreeView.Items.Insert(ANextNode, txt))
else
NewNode := TContentTreeNode(fTreeView.Items.AddChild(AParentNode, txt));
{$IF FPC_FULLVERSION>=30200}
URL:='';
for x:=0 to AItem.SubItemcount-1 do
@ -173,7 +178,7 @@ begin
Application.ProcessMessages;
for X := 0 to AItem.Children.Count-1 do
AddItem(AItem.Children.Item[X], NewNode);
AddSiteMapItem(AItem.Children.Item[X], NewNode, nil);
end;
constructor TContentsFiller.Create(ATreeView: TTreeView; ASitemap: TChmSiteMap; StopBoolean: PBoolean; AChm: TObject);
@ -185,15 +190,53 @@ begin
fChm := AChm;
end;
procedure TContentsFiller.DoFill(ParentNode: TTreeNode);
destructor TContentsFiller.Destroy;
begin
inherited Destroy;
end;
procedure TContentsFiller.DoFill(ParentNode: TTreeNode; ASortRoot: Boolean);
var
X: Integer;
IdxSm, IdxSrc: Integer;
begin
fTreeView.BeginUpdate;
for X := 0 to fSitemap.Items.Count-1 do
AddItem(fSitemap.Items.Item[X], ParentNode);
fTreeView.Enabled:= False;
if ASortRoot and (fTreeView.Items.Count > 0) and not Assigned(ParentNode) then
begin;
// merge sorted TreeNodes
IdxSrc:=0;
IdxSm:=0;
while (IdxSrc <> fTreeView.Items.TopLvlCount-1 ) and (IdxSm <> fSitemap.Items.Count-1) do
begin
if (UTF8CompareStrCollated(
LowerCase(fSitemap.Items.Item[IdxSm].Text),
LowerCase(fTreeView.Items.TopLvlItems[IdxSrc].Text)) <= 0) then
begin
// insert sitemap before fTreeView Node
AddSiteMapItem(fSitemap.Items.Item[IdxSm], ParentNode, fTreeView.Items.TopLvlItems[IdxSrc]);
if IdxSm < fSitemap.Items.Count-1 then
Inc(IdxSm);
end
else
begin
if IdxSrc < fTreeView.Items.TopLvlCount-1 then
Inc(IdxSrc)
end;
// Add a rest of nodes from sitemap
if (IdxSrc = fTreeView.Items.TopLvlCount-1) then
begin
AddSiteMapItem(fSitemap.Items.Item[IdxSm], ParentNode, ParentNode);
Inc(IdxSm);
end;
end;
end
else
begin
// Simple add of nodes
for IdxSm := 0 to fSitemap.Items.Count-1 do
AddSiteMapItem(fSitemap.Items.Item[IdxSm], ParentNode, nil);
end;
fTreeView.Enabled:= True;
fTreeView.EndUpdate;
end;

60
components/chmhelp/lhelp/filecontentprovider.pas
View File

@ -10,6 +10,7 @@ uses
type
{ TFileContentProvider }
TFileContentProviderClass = Class of TFileContentProvider;
TFileContentProvider = class(TBaseContentProvider)
private
@ -23,22 +24,42 @@ type
procedure GoBack; override;
procedure GoForward; override;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override;
class function GetRegisteredFileTypes(): TStringList;
constructor Create(AParent: TWinControl; AImageList: TImageList); override;
constructor Create(AParent: TWinControl; AImageList: TImageList; AUpdateCount: Integer); override;
end;
function RegisterFileType(const FileType: String; ContentProvider: TBaseContentProviderClass): Boolean;
function RegisterFileType(const AFileType: String; ContentProvider: TBaseContentProviderClass): Boolean;
implementation
var
FileContentProviders: TStringList;
function RegisterFileType(const FileType: String;
function RegisteredFileTypes( ) : TStringList;
begin
if FileContentProviders = nil Then // Singleton
FileContentProviders := TStringList.Create;
Result := FileContentProviders;
end;
function RegisterFileType(const AFileType: String;
ContentProvider: TBaseContentProviderClass): Boolean;
begin
Result := False;
if FileContentProviders.IndexOf(FileType) > -1 then exit;
FileContentProviders.AddObject(FileType, TObject(ContentProvider));
if RegisteredFileTypes.IndexOf(AFileType) > -1 then Exit;
RegisteredFileTypes.AddObject(AFileType, TObject(ContentProvider));
end;
function GetRegisteredFileType (
const AProviderClass: TBaseContentProviderClass ) : String;
var
fIndex: Integer;
begin
Result := '';
fIndex := RegisteredFileTypes.IndexOfObject(TObject(AProviderClass));
if fIndex = -1 then Exit;
Result := RegisteredFileTypes[fIndex];
end;
{ TFileContentProvider }
@ -80,33 +101,30 @@ class function TFileContentProvider.GetProperContentProvider(const AURL: String
var
fIndex: Integer;
fExt: String;
fFile: String;
fPos: Integer;
begin
Result := nil;
fFile := Copy(AUrl,8, Length(AURL));
fPos := Pos('://', fFile);
if fPos > 0 then begin
fFile := Copy(fFIle, 1, fPos-1);
end;
fExt := ExtractFileExt(fFile);
fExt := ExtractFileExt(GetUrlFilePath(AURL));
//WriteLn(fExt);
fIndex := FileContentProviders.IndexOf(fExt);
fIndex := RegisteredFileTypes.IndexOf(fExt);
if fIndex = -1 then exit;
Result := TBaseContentProviderClass(FileContentProviders.Objects[fIndex]);
Result := TBaseContentProviderClass(RegisteredFileTypes.Objects[fIndex]);
end;
constructor TFileContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
class function TFileContentProvider.GetRegisteredFileTypes ( ) : TStringList;
begin
inherited Create(AParent, AImageList);
Result:=RegisteredFileTypes();
end;
constructor TFileContentProvider.Create(AParent: TWinControl;
AImageList: TImageList; AUpdateCount: Integer);
begin
inherited Create(AParent, AImageList, AUpdateCount);
end;
initialization
FileContentProviders := TStringList.Create;
RegisterContentProvider('file://', TFileContentProvider);
RegisterContentProviderClass('file://', TFileContentProvider);
finalization

33
components/chmhelp/lhelp/httpcontentprovider.pas
View File

@ -30,8 +30,11 @@ type
procedure GoHome; override;
procedure GoBack; override;
procedure GoForward; override;
procedure ActivateTOCControl; override;
procedure ActivateIndexControl; override;
procedure ActivateSearchControl; override;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override;
constructor Create(AParent: TWinControl; AImageList: TImageList); override;
constructor Create(AParent: TWinControl; AImageList: TImageList; AUpdateCount:Integer); override;
end;
implementation
@ -98,15 +101,37 @@ begin
fHtml.GoForward;
end;
procedure THTTPContentProvider.ActivateTOCControl;
begin
//
end;
procedure THTTPContentProvider.ActivateIndexControl;
begin
//
end;
procedure THTTPContentProvider.ActivateSearchControl;
begin
//
end;
procedure THTTPContentProvider.ProcGlobalKeyUp(var Key: Word; Shift: TShiftState
);
begin
//
end;
class function THTTPContentProvider.GetProperContentProvider(const AURL: String
): TBaseContentProviderClass;
begin
Result := THTTPContentProvider;
end;
constructor THTTPContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
constructor THTTPContentProvider.Create(AParent: TWinControl; AImageList: TImageList;
AUpdateCount: Integer);
begin
inherited Create(AParent, AImageList);
inherited Create(AParent, AImageList, );
fPopUp := TPopupMenu.Create(fHtml);
fPopUp.Items.Add(TMenuItem.Create(fPopup));
with fPopUp.Items.Items[0] do begin
@ -118,7 +143,7 @@ begin
fHtml := TIpHtmlPanel.Create(Parent);
with fHtml do begin
DataProvider := fHttpDataProvider;
//OnDocumentOpen := @IpHtmlPanelDocumentOpen;
OnDocumentOpen := @IpHtmlPanelDocumentOpen;
OnHotChange := @IpHtmlPanelHotChange;
PopupMenu := fPopUp;
Parent := AParent;

44
components/chmhelp/lhelp/languages/lhelp.fi.po
View File

@ -9,6 +9,34 @@ msgstr "Tietoja"
msgid "&About ..."
msgstr "Tietoja..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -23,6 +51,10 @@ msgstr "Ei pysty hallitsemaan tämän tyyppistä sisältöä. \"%s\" url:%s%s"
msgid "&Close"
msgstr "&Sulje"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Sisältö"
@ -35,6 +67,10 @@ msgstr " --context : Näytä tähän sisältöön liittyvät avusteet"
msgid "Copy"
msgstr "Kopio"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "&Poistu"
@ -59,6 +95,10 @@ msgstr "Avuste tiedostot (*.chm)|*.chm|Kaikki tiedostot (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Näytä tämä avuste"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Käynnistä piilotettuna mutta salli yhteys IPC:n kautta"
@ -167,8 +207,8 @@ msgstr "Näytä sisältö"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Tuetut URL tyyppi(/tyypit): (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Tuetut URL tyyppi(/tyypit): [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.fr.po
View File

@ -19,6 +19,34 @@ msgstr "À propos"
msgid "&About ..."
msgstr "&À propos..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -33,6 +61,10 @@ msgstr "Impossible de prendre en charge ce type de contenu. \"%s\" pour l'URL :%
msgid "&Close"
msgstr "&Fermer"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Contenu"
@ -45,6 +77,10 @@ msgstr " --context : Afficher l'information d'aide relative au contexte"
msgid "Copy"
msgstr "Copier"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "Q&uitter"
@ -69,6 +105,10 @@ msgstr "Fichiers d'aide (*.chm) | *. chm| Tous les fichiers (*. *) | *"
msgid " --help : Show this information"
msgstr " --help : Afficher cette information"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Démarrer en mode caché mais accepter les communications via IPC"
@ -177,8 +217,8 @@ msgstr "Afficher le contenu"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Type(s) d'URL pris en charge : (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Type(s) d'URL pris en charge : [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.hu.po
View File

@ -19,6 +19,34 @@ msgstr "Névjegy"
msgid "&About ..."
msgstr "&Névjegy ..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -33,6 +61,10 @@ msgstr "Nem kezelhetők az ilyen típusú altartalmak. \"%s\" a következő url-
msgid "&Close"
msgstr "Be&zárás"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Tartalom"
@ -45,6 +77,10 @@ msgstr " --context : Megjeleníti az azonosítóhoz tartozó súgót"
msgid "Copy"
msgstr "Másolás"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "Kilé&pés"
@ -69,6 +105,10 @@ msgstr "Súgó fájlok (*.chm)|*.chm|Minden fájl (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Megjeleníti ezt a súgót"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Rejtve indul, de fogadja az IPC kéréseket"
@ -177,8 +217,8 @@ msgstr "Tartalom megjelenítése"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Támogatott URL típus(ok): (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Támogatott URL típus(ok): [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.lt.po
View File

@ -20,6 +20,34 @@ msgstr "Apie"
msgid "&About ..."
msgstr "&Apie…"
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -34,6 +62,10 @@ msgstr "Neįmanoma apdoroti šio tipo poturinio „%s“ adresui: %s%s"
msgid "&Close"
msgstr "Už&verti"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Turiniai"
@ -46,6 +78,10 @@ msgstr " --context : Rodyti su šiuo turiniu sisijusią žinyno informacij
msgid "Copy"
msgstr "Kopijuoti"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "&Baigti darbą"
@ -70,6 +106,10 @@ msgstr "Žinyno failai (*.chm)|*.chm|Visi failai (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Rodyti šia informaciją"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Darba pradėti pasislėpus, tačiau komunikuoti naudojant „IPC“"
@ -178,8 +218,8 @@ msgstr "Rodyti turinį"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Palaikomas adreso tipas(-ai): (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Palaikomas adreso tipas(-ai): [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.pl.po
View File

@ -20,6 +20,34 @@ msgstr "Informacja"
msgid "&About ..."
msgstr "&O..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -34,6 +62,10 @@ msgstr ""
msgid "&Close"
msgstr "&Zamknij"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Zawartość"
@ -46,6 +78,10 @@ msgstr ""
msgid "Copy"
msgstr "Kopiuj"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "&Wyjście"
@ -70,6 +106,10 @@ msgstr "Pliki pomocy (*.chm)|*.chm|Wszystkie pliki (*.*)|*"
msgid " --help : Show this information"
msgstr ""
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr ""
@ -178,8 +218,8 @@ msgstr "Pokaż zawartość"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Obsługiwane typy URL: (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Obsługiwane typy URL: [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

42
components/chmhelp/lhelp/languages/lhelp.pot
View File

@ -9,6 +9,34 @@ msgstr ""
msgid "&About ..."
msgstr ""
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -23,6 +51,10 @@ msgstr ""
msgid "&Close"
msgstr ""
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr ""
@ -35,6 +67,10 @@ msgstr ""
msgid "Copy"
msgstr ""
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr ""
@ -59,6 +95,10 @@ msgstr ""
msgid " --help : Show this information"
msgstr ""
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr ""
@ -167,7 +207,7 @@ msgstr ""
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr ""
#: lhelpstrconsts.slhelp_tableofcontentsloading

44
components/chmhelp/lhelp/languages/lhelp.pt_BR.po
View File

@ -19,6 +19,34 @@ msgstr "Sobre"
msgid "&About ..."
msgstr "&Sobre ..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -33,6 +61,10 @@ msgstr "Impossível lidar com este tipo de subconteúdo. \"%s\" para a url:%s%s"
msgid "&Close"
msgstr "&Fechar"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Conteúdo"
@ -45,6 +77,10 @@ msgstr " --context : Exibe a informação de ajuda relacionada à este cont
msgid "Copy"
msgstr "Copiar"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "&Sair"
@ -69,6 +105,10 @@ msgstr "Arquivos de ajuda (*.chm)|*.chm|Todos (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Exibe esta informação"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Inicia oculto mas aceita comunicação via IPC"
@ -177,8 +217,8 @@ msgstr "Exibir conteúdo"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Tipo de URL suportado: (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Tipo de URL suportado: [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

46
components/chmhelp/lhelp/languages/lhelp.ru.po
View File

@ -17,6 +17,36 @@ msgstr "О программе"
msgid "&About ..."
msgstr "&О программе ..."
#: lhelpstrconsts.slhelp_actions
#, fuzzy
#| msgid "Actions"
msgid "&Actions"
msgstr "Действия"
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr "Назад"
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr "Вперед"
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr "Домой"
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr "Искать по индексу"
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr "Полнотекстовый поиск"
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr "Содержание"
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -31,6 +61,10 @@ msgstr "Невозможно обработать данный тип содер
msgid "&Close"
msgstr "&Закрыть"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Содержание"
@ -43,6 +77,10 @@ msgstr " --context : Вывести справку по данному ко
msgid "Copy"
msgstr "Копировать"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr "Копировать HTML"
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "В&ыход"
@ -67,6 +105,10 @@ msgstr "Файлы справки (*.chm)|*.chm|Все файлы (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Вывести данную информацию"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr "Свернуть"
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Запуститься скрыто, но взаимодействовать по IPC"
@ -176,8 +218,8 @@ msgstr "Показывать содержание"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Поддерживаемые типы адресов: (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Поддерживаемые типы адресов: [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.uk.po
View File

@ -20,6 +20,34 @@ msgstr "Про програму"
msgid "&About ..."
msgstr "&Про програму ..."
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -34,6 +62,10 @@ msgstr "Неможливо обробити вміст даного типу. \"
msgid "&Close"
msgstr "&Закрити"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "Зміст"
@ -46,6 +78,10 @@ msgstr " --context : Вивести довідку щодо даного к
msgid "Copy"
msgstr "Копіювати"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "В&ихід"
@ -70,6 +106,10 @@ msgstr "Файли довідки (*.chm)|*.chm|Всі файли (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : Вивести дану інформацію"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide : Запуститися приховано, але взаємодіяти через IPC"
@ -178,8 +218,8 @@ msgstr "Показувати зміст"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "Підтримувані типи адрес: (%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "Підтримувані типи адрес: [ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

44
components/chmhelp/lhelp/languages/lhelp.zh_CN.po
View File

@ -20,6 +20,34 @@ msgstr "关于"
msgid "&About ..."
msgstr "关于...(&A)"
#: lhelpstrconsts.slhelp_actions
msgid "&Actions"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoback
msgid "Go back"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgoforward
msgid "Go forward"
msgstr ""
#: lhelpstrconsts.slhelp_actionsgohome
msgid "Go home"
msgstr ""
#: lhelpstrconsts.slhelp_actionsindex
msgid "Search by &index"
msgstr ""
#: lhelpstrconsts.slhelp_actionssearch
msgid "&Search by text"
msgstr ""
#: lhelpstrconsts.slhelp_actionstoc
msgid "&TOC"
msgstr ""
#: lhelpstrconsts.slhelp_cannothandlethistypeofcontentforurl
#, object-pascal-format
msgid "Cannot handle this type of content. \"%s\" for url:%s%s"
@ -34,6 +62,10 @@ msgstr "不能处理这个子目录(subcontent)的类型.\"%s\"对于url:%s%s"
msgid "&Close"
msgstr "关闭(&C)"
#: lhelpstrconsts.slhelp_closeconfirm
msgid "You can use the Esc to hide Help. Are you realy want to close lHelp?"
msgstr ""
#: lhelpstrconsts.slhelp_contents
msgid "Contents"
msgstr "目录"
@ -46,6 +78,10 @@ msgstr " --context : 显示关于这个上下文的帮助信息"
msgid "Copy"
msgstr "复制"
#: lhelpstrconsts.slhelp_copyhtmlsource
msgid "Copy html source"
msgstr ""
#: lhelpstrconsts.slhelp_exit
msgid "E&xit"
msgstr "退出(&x)"
@ -70,6 +106,10 @@ msgstr "Help文件(*.chm)|*.chm|所有文件 (*.*)|*"
msgid " --help : Show this information"
msgstr " --help : 显示此信息"
#: lhelpstrconsts.slhelp_hide
msgid "&Hide"
msgstr ""
#: lhelpstrconsts.slhelp_hidestarthiddenbutacceptcommunicationsviaipc
msgid " --hide : Start hidden but accept communications via IPC"
msgstr " --hide :开始隐藏 但是通过IPC接受通讯"
@ -178,8 +218,8 @@ msgstr "显示目录(contents)"
#: lhelpstrconsts.slhelp_supportedurltypes
#, object-pascal-format
msgid "Supported URL type(s): (%s)"
msgstr "支持的URL类型:(%s)"
msgid "Supported URL type(s): [ %s ]"
msgstr "支持的URL类型:[ %s ]"
#: lhelpstrconsts.slhelp_tableofcontentsloading
msgid "Table of Contents Loading ..."

96
components/chmhelp/lhelp/lhelp.lpi
View File

@ -15,43 +15,14 @@
<EnableI18N Value="True" LFM="False"/>
<OutDir Value="languages"/>
</i18n>
<BuildModes Count="2">
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
<Item2 Name="debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lhelp"/>
</Target>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
</Item2>
<SharedMatrixOptions Count="4">
<Item1 ID="214272031317" Value="-dCHM_DEBUG_TIME"/>
<Item2 ID="183734626213" Value="-dUPDATE_CNT"/>
<Item3 ID="934914140281" Value="-dTREE_DEBUG"/>
<Item4 ID="139067857239" Value="-dLDEBUG"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -71,17 +42,20 @@
</Mode0>
</Modes>
</RunParams>
<RequiredPackages Count="3">
<RequiredPackages Count="4">
<Item1>
<PackageName Value="TurboPowerIPro"/>
<MinVersion Major="1" Valid="True"/>
<PackageName Value="lazmouseandkeyinput"/>
</Item1>
<Item2>
<PackageName Value="lhelpcontrolpkg"/>
<PackageName Value="TurboPowerIPro"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
<PackageName Value="lhelpcontrolpkg"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="10">
<Unit0>
@ -99,38 +73,40 @@
<UnitName Value="ChmSpecialParser"/>
</Unit2>
<Unit3>
<Filename Value="chmpopup.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="HelpPopupForm"/>
<ResourceBaseClass Value="Form"/>
</Unit3>
<Unit4>
<Filename Value="lhelpcore.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="HelpForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit4>
<Unit5>
<UnitName Value="LHelpCore"/>
</Unit3>
<Unit4>
<Filename Value="lnethttpdataprovider.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<UnitName Value="LNetHTTPDataProvider"/>
</Unit4>
<Unit5>
<Filename Value="basecontentprovider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BaseContentProvider"/>
</Unit6>
<Unit7>
</Unit5>
<Unit6>
<Filename Value="chmcontentprovider.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<UnitName Value="ChmContentProvider"/>
</Unit6>
<Unit7>
<Filename Value="httpcontentprovider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="HTTPContentProvider"/>
</Unit7>
<Unit8>
<Filename Value="lhelpstrconsts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="LHelpStrConsts"/>
</Unit8>
<Unit9>
<Filename Value="lhelpstrconsts.pas"/>
<Filename Value="filecontentprovider.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
</Units>
@ -150,8 +126,14 @@
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>

5
components/chmhelp/lhelp/lhelp.lpr
View File

@ -26,8 +26,8 @@ uses
cthreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
SysUtils, Classes, Controls, Dialogs, Forms,
SimpleIPC, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore, lhelpstrconsts;
SysUtils, Classes, Controls, Dialogs, Forms, lazmouseandkeyinput,
SimpleIPC, lhelpcontrolpkg, lhelpcore, lhelpstrconsts, filecontentprovider;
var
X: Integer;
@ -64,7 +64,6 @@ begin
end;
end;
Application.CreateForm(THelpForm, HelpForm);
Application.CreateForm(THelpPopupForm, HelpPopupForm);
try
Application.Run;

142
components/chmhelp/lhelp/lhelpcore.lfm
View File

@ -1,11 +1,12 @@
object HelpForm: THelpForm
Left = 582
Height = 535
Top = 318
Width = 758
Left = 413
Height = 585
Top = 199
Width = 829
Caption = 'LHelp'
ClientHeight = 515
ClientWidth = 758
ClientHeight = 563
ClientWidth = 829
DesignTimePPI = 106
Icon.Data = {
7E04000000000100010010100000010020006804000016000000280000001000
0000200000000100200000000000000400006400000064000000000000000000
@ -45,56 +46,73 @@ object HelpForm: THelpForm
0000000000000000000000000000000000000000000000000000000000000000
0000
}
KeyPreview = True
Menu = MainMenu1
OnClose = FormClose
OnCreate = FormCreate
OnKeyUp = FormKeyUp
OnKeyDown = FormKeyDown
OnShow = FormShow
OnWindowStateChange = FormWindowStateChange
Position = poScreenCenter
LCLVersion = '2.1.0.0'
LCLVersion = '2.0.11.0'
Visible = True
object PageControl: TPageControl
Left = 0
Height = 481
Top = 34
Width = 758
Height = 525
Top = 38
Width = 829
Align = alClient
MultiLine = True
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 0
TabPosition = tpBottom
OnChange = PageControlChange
OnEnter = PageControlEnter
Options = [nboMultiLine]
end
object ToolBar1: TToolBar
Left = 0
Height = 34
Height = 38
Top = 0
Width = 758
ButtonHeight = 32
ButtonWidth = 32
Width = 829
ButtonHeight = 35
ButtonWidth = 35
Caption = 'ToolBar1'
EdgeBorders = []
Images = ImageListToolbar
ParentFont = False
TabOrder = 1
object HomeBttn: TToolButton
Left = 41
Left = 44
Hint = 'Home'
Top = 0
Caption = 'HomeBttn'
Caption = 'Go Home'
ImageIndex = 0
OnClick = HomeToolBtnClick
OnClick = MiActionsGoHomeClick
ParentShowHint = False
ShowHint = True
end
object BackBttn: TToolButton
Left = 73
Left = 79
Hint = 'Go Back'
Top = 0
Caption = 'BackBttn'
Caption = 'Go back'
ImageIndex = 1
OnClick = BackToolBtnClick
OnClick = MiActionsGoBackClick
ParentShowHint = False
ShowHint = True
end
object ForwardBttn: TToolButton
Left = 105
Left = 114
Hint = 'Go forward'
Top = 0
Caption = 'ForwardBttn'
Caption = 'Go forward'
ImageIndex = 2
OnClick = ForwardToolBtnClick
OnClick = MiActionsGoForwardClick
ParentShowHint = False
ShowHint = True
end
object FileButton: TToolButton
Left = 1
@ -104,16 +122,16 @@ object HelpForm: THelpForm
OnClick = FileMenuOpenItemClick
end
object ToolButton1: TToolButton
Left = 33
Height = 32
Left = 36
Height = 35
Top = 0
Caption = 'ToolButton1'
Style = tbsSeparator
end
end
object MainMenu1: TMainMenu
left = 208
top = 80
Left = 230
Top = 96
object FileMenuItem: TMenuItem
Caption = '&File'
object FileMenuOpenItem: TMenuItem
@ -134,13 +152,19 @@ object HelpForm: THelpForm
ShortCut = 16471
OnClick = FileMenuCloseItemClick
end
object MiHide: TMenuItem
Caption = 'Hide'
Hint = 'Hide'
ShortCut = 27
OnClick = MiHideClick
end
object FileSeperater: TMenuItem
Caption = '-'
end
object FileMenuExitItem: TMenuItem
Caption = 'E&xit'
ShortCut = 27
OnClick = FileMenuExitItemClick
object MiQuit: TMenuItem
Caption = 'Quit'
ShortCut = 32883
OnClick = MiQuitClick
end
end
object ViewMenuItem: TMenuItem
@ -162,11 +186,47 @@ object HelpForm: THelpForm
OnClick = ViewShowSepTabsClick
end
end
object MiActions: TMenuItem
Caption = '&Actions'
object MiActionsTOC: TMenuItem
Caption = 'TOC'
ShortCut = 16468
OnClick = MiActionsTOCClick
end
object MiActionsIndex: TMenuItem
Caption = 'Search by index'
ShortCut = 16457
OnClick = MiActionsIndexClick
end
object MiActionsSearch: TMenuItem
Caption = 'Search by text'
ShortCut = 16467
OnClick = MiActionsSearchClick
end
object MenuItem2: TMenuItem
Caption = '-'
end
object MiActionsGoHome: TMenuItem
Caption = 'Go Home'
ShortCut = 32804
OnClick = MiActionsGoHomeClick
end
object MiActionsGoBack: TMenuItem
Caption = 'Go Back'
ShortCut = 32805
OnClick = MiActionsGoBackClick
end
object MiActionsGoForward: TMenuItem
Caption = 'Go Forward'
ShortCut = 32807
OnClick = MiActionsGoForwardClick
end
end
object HelpMenuItem: TMenuItem
Caption = '&Help'
OnClick = HelpMenuItemClick
object AboutItem: TMenuItem
Caption = '&About...'
ShortCut = 112
OnClick = AboutItemClick
end
end
@ -174,12 +234,12 @@ object HelpForm: THelpForm
object OpenDialog1: TOpenDialog
Filter = 'Help files (*.chm)|*.chm|All files (*.*)|*'
FilterIndex = 0
left = 248
top = 92
Left = 232
Top = 176
end
object ImageList1: TImageList
left = 80
top = 75
Left = 48
Top = 96
Bitmap = {
4C690400000010000000100000007001E300B0CE2A000000000000000000F609
0200E1281B00005959000090AF00329FCCFF75888800003A3A00000E0E00FA11
@ -315,14 +375,14 @@ object HelpForm: THelpForm
object ApplicationProperties1: TApplicationProperties
ShowButtonGlyphs = sbgSystem
ShowMenuGlyphs = sbgSystem
left = 80
top = 136
Left = 56
Top = 176
end
object ImageListToolbar: TImageList
Height = 22
Width = 22
left = 120
top = 88
Left = 144
Top = 96
Bitmap = {
4C69040000001600000016000000000000000000000000000000000000000000
0000000000000000000000000000000000000000A4190000A4FF0000A4FF0000

540
components/chmhelp/lhelp/lhelpcore.pas
View File

@ -22,7 +22,7 @@ Icons from Tango theme:
http://tango.freedesktop.org/Tango_Icon_Library
}
unit lhelpcore;
unit LHelpCore;
{$IFDEF LNET_VISUAL}
{$DEFINE USE_LNET} // you must manually add the lnetvisual.lpk package to the dependancy list
@ -40,10 +40,10 @@ uses
Forms, Controls, Dialogs, Buttons, ComCtrls, ExtCtrls, Menus, StdCtrls,
LCLProc, LCLType, LCLIntf, DefaultTranslator,
// LazUtils
LazFileUtils, LazUTF8, LazLogger,
LazFileUtils, LazUTF8, LazLoggerBase,
// ChmHelp
{$IFDEF USE_LNET}HTTPContentProvider,{$ENDIF}
BaseContentProvider, ChmContentProvider, lhelpstrconsts;
BaseContentProvider, filecontentprovider, ChmContentProvider, lhelpstrconsts;
type
@ -63,7 +63,7 @@ type
THelpForm = class(TForm)
ApplicationProperties1: TApplicationProperties;
FileMenuCloseItem: TMenuItem;
FileMenuExitItem: TMenuItem;
MiQuit: TMenuItem;
FileMenuItem: TMenuItem;
FileMenuOpenItem: TMenuItem;
FileSeperater: TMenuItem;
@ -74,6 +74,14 @@ type
HelpMenuItem: TMenuItem;
AboutItem: TMenuItem;
FileMenuOpenRecentItem: TMenuItem;
MiHide: TMenuItem;
MiActionsGoBack: TMenuItem;
MiActionsGoForward: TMenuItem;
MiActionsGoHome: TMenuItem;
MiActions: TMenuItem;
MiActionsSearch: TMenuItem;
MiActionsIndex: TMenuItem;
MiActionsTOC: TMenuItem;
ViewShowStatus: TMenuItem;
ViewShowSepTabs: TMenuItem;
PageControl: TPageControl;
@ -87,17 +95,24 @@ type
ViewMenuContents: TMenuItem;
ViewMenuItem: TMenuItem;
procedure AboutItemClick(Sender: TObject);
procedure BackToolBtnClick(Sender: TObject);
procedure FileMenuCloseItemClick(Sender: TObject);
procedure FileMenuExitItemClick(Sender: TObject);
procedure FileMenuOpenItemClick(Sender: TObject);
procedure FileMenuOpenURLItemClick(Sender: TObject);
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormKeyDown ( Sender: TObject; var Key: Word; Shift: TShiftState
) ;
procedure FormShow(Sender: TObject);
procedure ForwardToolBtnClick(Sender: TObject);
procedure HomeToolBtnClick(Sender: TObject);
procedure FormWindowStateChange(Sender: TObject);
procedure MiActionsGoForwardClick ( Sender: TObject ) ;
procedure HelpMenuItemClick ( Sender: TObject ) ;
procedure MiHideClick ( Sender: TObject ) ;
procedure MiActionsGoBackClick ( Sender: TObject ) ;
procedure MiActionsGoHomeClick ( Sender: TObject ) ;
procedure MiActionsIndexClick ( Sender: TObject ) ;
procedure MiQuitClick ( Sender: TObject ) ;
procedure MiActionsSearchClick ( Sender: TObject ) ;
procedure MiActionsTOCClick ( Sender: TObject ) ;
procedure PageControlChange(Sender: TObject);
procedure PageControlEnter(Sender: TObject);
procedure ViewMenuContentsClick(Sender: TObject);
@ -120,8 +135,12 @@ type
fShowSepTabs: Boolean;
fShowStatus: Boolean;
fHasShowed: Boolean;
fMustClose: boolean;
fDefWinMax: Boolean;
fDefWinSize: TRect;
fHide: boolean; //If yes, start with content hidden. Otherwise start normally
fUpdateCount: Integer;
fLastHiddenRequest: String;
// Keep track of whether size/position preferences were loaded and applied to form
fLayoutApplied: boolean;
// Applies layout (size/position/fullscreen) preferences once in lhelp lifetime
@ -133,6 +152,7 @@ type
procedure SavePreferences;
// Add filename to recent files (MRU) list
procedure AddRecentFile(AFileName: String);
procedure DeleteRecentFile(AFileName: String);
procedure ContentTitleChange({%H-}sender: TObject);
procedure OpenRecentItemClick(Sender: TObject);
// Send response back to server (IDE)
@ -156,16 +176,17 @@ type
// Update UI visibility
procedure RefreshState;
procedure ShowError(AError: String);
// Set keyup handler for control (and any child controls)
procedure SetKeyUp(AControl: TControl);
// BeginUpdate tells each content provider to possibly stop some events
procedure BeginUpdate;
// EndUpdate tells each content provider to resume normal behavior
procedure EndUpdate;
// Bring App on Top and show
procedure ShowApp();
// Event process
procedure DoShowContent(Sender:Tobject);
public
{ public declarations }
end;
var
HelpForm: THelpForm;
@ -176,14 +197,14 @@ var
const
INVALID_FILE_TYPE = 1;
VERSION_STAMP = '2014-10-16'; //used in displaying version in about form etc
VERSION_STAMP = '2020-12-10'; //used in displaying version in about form etc
implementation
{$R *.lfm}
uses
LHelpControl;
LHelpControl, MouseAndkeyInput;
const
DigitsInPID=5; // Number of digits in the formatted PID according to the Help Protocol
@ -196,12 +217,6 @@ type
{ THelpForm }
procedure THelpForm.BackToolBtnClick(Sender: TObject);
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.GoBack;
end;
procedure THelpForm.AboutItemClick(Sender: TObject);
var
f: TForm;
@ -218,6 +233,7 @@ begin
l := TLabel.Create(f);
l.Parent := f;;
l.Align := alTop;
l.Alignment:=taCenter;
l.BorderSpacing.Around := 6;
l.Caption := Format(slhelp_LHelpCHMFileViewerVersionCopyrightCAndrewHainesLaz, [LineEnding, VERSION_STAMP, LineEnding +
LineEnding, LineEnding]);
@ -241,7 +257,6 @@ begin
end;
end;
procedure THelpForm.FileMenuCloseItemClick(Sender: TObject);
begin
if Assigned(ActivePage) then
@ -252,11 +267,6 @@ begin
end;
end;
procedure THelpForm.FileMenuExitItemClick(Sender: TObject);
begin
Close;
end;
procedure THelpForm.FileMenuOpenItemClick(Sender: TObject);
var
TimerWasOn: boolean;
@ -291,21 +301,33 @@ procedure THelpForm.FileMenuOpenURLItemClick(Sender: TObject);
var
fRes: String;
URLSAllowed: String;
Protocol: TStrings;
i: Integer;
FileExt: String;
Protocol: TStringList;
FileTypes: TStringList;
i, ii: Integer;
begin
Protocol := GetContentProviderList;
try
URLSAllowed:='';
for i := 0 to Protocol.Count-1 do
URLSAllowed:='';
for i := 0 to Protocol.Count-1 do
begin
FileExt := '';
if i < 1 then
URLSAllowed := URLSAllowed + Protocol[i]
else
URLSAllowed := URLSAllowed + ', ' +Protocol[i];
if TBaseContentProviderClass(Protocol.Objects[i]) = TFileContentProvider then
begin
if i < 1 then
URLSAllowed := URLSAllowed + Protocol[i]
else
URLSAllowed := URLSAllowed + ', ' +Protocol[i]
FileTypes := TFileContentProviderClass(Protocol.Objects[i]).GetRegisteredFileTypes();
for ii := 0 to Pred(FileTypes.Count) do
begin
if ii < 1 Then
FileExt:= FileTypes[ii]
else
FileExt:= FileExt + ', '+FileTypes[ii];
end;
if FileExt<>'' then
URLSAllowed := URLSAllowed + '(*'+FileExt+')';
end;
finally
Protocol.Free;
end;
URLSAllowed := Trim(URLSAllowed);
@ -322,13 +344,20 @@ end;
procedure THelpForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if not fMustClose then
if MessageDlg(slhelp_LHelp, slhelp_CloseConfirm, mtConfirmation, mbYesNo, '') <> mrYes then
begin
CloseAction:= caNone;
Application.Minimize();
Exit;
end;
//close all tabs to avoid AV with many tabs
while Assigned(ActivePage) do
BeginUpdate;
PageControl.ShowTabs:= False;
while TContentTab(ActivePage) <>nil do
ActivePage.Free;
////was before: close tab
////FileMenuCloseItemClick(Sender);
Visible := false;
EndUpdate;
//Visible := false;
Application.ProcessMessages;
StopComms;
SavePreferences;
@ -341,18 +370,34 @@ begin
FileMenuOpenRecentItem.Caption := slhelp_OpenRecent;
FileMenuOpenURLItem.Caption := slhelp_OpenURL;
FileMenuCloseItem.Caption := slhelp_Close;
FileMenuExitItem.Caption := slhelp_EXit;
MiHide.Caption := slhelp_Hide;
MiQuit.Caption := slhelp_EXit;
MiActions.Caption:= slhelp_Actions;
MiActionsTOC.Caption:= slhelp_ActionsTOC;
MiActionsIndex.Caption:= slhelp_ActionsIndex;
MiActionsSearch.Caption:= slhelp_ActionsSearch;
MiActionsGoHome.Caption:= slhelp_ActionsGoHome;
MiActionsGoBack.Caption:= slhelp_ActionsGoBack;
MiActionsGoForward.Caption:= slhelp_ActionsGoForward;
ViewMenuItem.Caption := slhelp_View;
ViewMenuContents.Caption := slhelp_ShowContents;
ViewShowStatus.Caption := slhelp_OpenNewTabWithStatusBar;
ViewShowSepTabs.Caption := slhelp_OpenNewFileInSeparateTab;
HelpMenuItem.Caption := slhelp_Help;
BackBttn.Hint:= MiActionsGoBack.Caption;
ForwardBttn.Hint:= MiActionsGoForward.Caption;
HomeBttn.Hint:= MiActionsGoHome.Caption;
FileButton.Hint:= FileMenuOpenItem.Caption;
AboutItem.Caption := slhelp_About2;
OpenDialog1.Title := slhelp_OpenExistingFile;
OpenDialog1.Filter := slhelp_HelpFilesChmChmAllFiles;
fMustClose:= false;
fContext := -1;
fUpdateCount:= 0;
// Safe default:
fHide := false;
// ReadCommandLineOptions will set fHide if requested
@ -368,18 +413,26 @@ begin
WindowState := wsMinimized
else
RefreshState;
SetKeyUp(Self);
end;
procedure THelpForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure THelpForm.FormKeyDown ( Sender: TObject; var Key: Word;
Shift: TShiftState ) ;
begin
if Key = VK_ESCAPE then
Close;
// Backspace: go to previous page (as if BackBttn were clicked)
if Key = VK_BACK then
if Assigned(ActivePage) then ActivePage.ContentProvider.GoBack;
//if (Shift = [ssAlt]) then
//case Key of
// VK_Left: begin
// MiActionsGoHomeClick(Sender); key:= 0;
// end;
// VK_RIGHT: begin
// MiActionsGoForwardClick(Sender); key:= 0;
// end;
// VK_Home: begin
// MiActionsGoBackClick(Sender); key:= 0;
// end;
//end;
end;
procedure THelpForm.FormShow(Sender: TObject);
begin
if FHasShowed then
@ -387,16 +440,54 @@ begin
FHasShowed := True;
end;
procedure THelpForm.ForwardToolBtnClick(Sender: TObject);
procedure THelpForm.MiActionsGoForwardClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.GoForward;
end;
procedure THelpForm.HomeToolBtnClick(Sender: TObject);
procedure THelpForm.HelpMenuItemClick ( Sender: TObject ) ;
begin
end;
procedure THelpForm.MiHideClick ( Sender: TObject ) ;
begin
if WindowState <> wsMinimized then
Application.Minimize();
//Visible := False;
end;
procedure THelpForm.MiActionsGoBackClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.GoBack;
end;
procedure THelpForm.MiActionsGoHomeClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.GoHome;
end;
procedure THelpForm.MiActionsIndexClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.ActivateIndexControl;
end;
procedure THelpForm.MiQuitClick ( Sender: TObject ) ;
begin
fMustClose:= True;
Close();
end;
procedure THelpForm.MiActionsSearchClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.ActivateSearchControl;
end;
procedure THelpForm.MiActionsTOCClick ( Sender: TObject ) ;
begin
if Assigned(ActivePage) then ActivePage.ContentProvider.ActivateTOCControl;
end;
procedure THelpForm.PageControlChange(Sender: TObject);
begin
RefreshState;
@ -407,21 +498,39 @@ begin
RefreshState;
end;
procedure THelpForm.FormWindowStateChange(Sender: TObject);
begin
if Windowstate = wsNormal then
begin
Left := fDefWinSize.Left;
Top := fDefWinSize.Top;
Width := fDefWinSize.Width;
Height := fDefWinSize.Height;
end;
end;
procedure THelpForm.ApplyLayoutPreferencesOnce;
begin
if not Assigned(fConfig) then exit;
if (not fHide) and (not fLayoutApplied) then
begin
if fConfig.GetValue('Position/Maximized', false) then
fDefWinSize.Left := fConfig.GetValue('Position/Left/Value', Left);
fDefWinSize.Top := fConfig.GetValue('Position/Top/Value', Top);
fDefWinSize.Width := fConfig.GetValue('Position/Width/Value', Width);
fDefWinSize.Height := fConfig.GetValue('Position/Height/Value', Height);
fDefWinMax:= fConfig.GetValue('Position/Maximized', false);
if fDefWinMax then
begin
Windowstate := wsMaximized
Windowstate := wsMaximized;
end
else
begin
Left := fConfig.GetValue('Position/Left/Value', Left);
Top := fConfig.GetValue('Position/Top/Value', Top);
Width := fConfig.GetValue('Position/Width/Value', Width);
Height := fConfig.GetValue('Position/Height/Value', Height);
Windowstate := wsNormal;
Left := fDefWinSize.Left;
Top := fDefWinSize.Top;
Width := fDefWinSize.Width;
Height := fDefWinSize.Height;
end;
// Keep track so we do not reapply initial settings as user may have
// changed size etc in the meantime.
@ -477,7 +586,10 @@ begin
// server-dependent constant together with a process ID.
// Strip out the formatted process ID to get fixed config file names for
// one server
ServerPart := Copy(AIPCName, 1, length(AIPCName)-DigitsInPID);
if (AIPCName <> '') then
ServerPart := Copy(AIPCName, 1, length(AIPCName)-DigitsInPID)
else
ServerPart:= 'standalone';
PrefFile := Format('%slhelp-%s.conf',[IncludeTrailingPathDelimiter(PrefFile), ServerPart]);
fConfig := TXMLConfig.Create(Self);
@ -557,6 +669,15 @@ begin
FileMenuOpenRecentItem.Items[MaxHistory-1].Free;
end;
procedure THelpForm.DeleteRecentFile ( AFileName: String ) ;
var
i: Integer;
begin
for i := FileMenuOpenRecentItem.Count-1 downto 0 do
if TRecentMenuItem(FileMenuOpenRecentItem.Items[i]).URL = AFileName then
FileMenuOpenRecentItem.Delete(i);
end;
procedure THelpForm.ContentTitleChange(sender: TObject);
begin
if ActivePage = nil then
@ -573,7 +694,10 @@ begin
if res = Ord(srSuccess) then
AddRecentFile(Item.URL)
else
begin
MessageDlg(Format(slhelp_NotFound, [Item.URL]), mtError, [mbOK], 0);
DeleteRecentFile(Item.URL);
end;
end;
procedure THelpForm.SendResponse(Response: DWord);
@ -596,7 +720,6 @@ var
FileReq: TFileRequest;
ConReq: TContextRequest;
MiscReq: TMiscRequest;
MustClose: boolean=false;
Stream: TStream;
Res: LongWord;
Url: String='';
@ -612,34 +735,50 @@ begin
rtFile:
begin
Url := 'file://'+FileReq.FileName;
DebugLn('got rtFile, filename '+filereq.filename);
{$IFDEF SHOW_ON_REQUEST}
fHide := false;
RefreshState;
ShowApp();
{$ENDIF}
Res := OpenURL(URL);
//debugln('got rtfile, filename '+filereq.filename);
end;
rtUrl:
begin
Stream.Position := 0;
FillByte(UrlReq{%H-},SizeOf(UrlReq),0);
Stream.Read(UrlReq, SizeOf(UrlReq));
{$IFDEF SHOW_ON_REQUEST}
fHide := false;
RefreshState;
ShowApp();
{$ENDIF}
if UrlReq.FileRequest.FileName <> '' then
begin
Url := 'file://'+UrlReq.FileRequest.FileName;
DebugLn('got rturl, filename '+urlreq.filerequest.filename+', url '+urlreq.url);
Res := OpenUrl(URL+'://'+UrlReq.Url);
end
else
begin
Url := UrlReq.Url;
DebugLn('got rturl, filename '+urlreq.filerequest.filename+', url '+urlreq.url);
Res := OpenURL(Url);
end;
//debugln('got rturl, filename '+urlreq.filerequest.filename+', url '+urlreq.url);
end;
rtContext:
begin
Stream.Position := 0;
FillByte(ConReq{%H-},SizeOf(ConReq),0);
Stream.Read(ConReq, SizeOf(ConReq));
Url := 'file://'+FileReq.FileName;
Url := 'file://'+ConReq.FileRequest.FileName;
DebugLn('got rtcontext, filename '+ConReq.FileRequest.FileName+', context '+inttostr(ConReq.HelpContext));
{$IFDEF SHOW_ON_REQUEST}
fHide := false;
RefreshState;
ShowApp();
{$ENDIF}
Res := OpenURL(Url, ConReq.HelpContext);
//debugln('got rtcontext, filename '+filereq.filename+', context '+inttostr(ConReq.HelpContext));
end;
rtMisc:
begin
@ -649,41 +788,47 @@ begin
case MiscReq.RequestID of
mrClose:
begin
MustClose:=true;
fMustClose:=true;
Res:= ord(srSuccess);
//debugln('got rtmisc/mrClose');
//DebugLn('got rtmisc/mrClose');
end;
mrShow:
begin
fHide := false;
if WindowState = wsMinimized then
WindowState := wsNormal;
RefreshState;
Res := ord(srSuccess);
//debugln('got rtmisc/mrShow');
DebugLn('got rtmisc/mrShow');
fHide := false;
if (fUpdateCount = 0) and (fLastHiddenRequest <> '')then
begin
DebugLn('mrShow OpenUrl '+fLastHiddenRequest);
Res := OpenURL(fLastHiddenRequest);
fLastHiddenRequest:= '';
end;
RefreshState;
ShowApp();
end;
mrVersion:
begin
// Protocol version encoded in the filename
// Verify what we support
if strtointdef(FileReq.FileName,0)=strtointdef(PROTOCOL_VERSION,0) then
if strtointdef(MiscReq.FileRequest.FileName,0)=strtointdef(PROTOCOL_VERSION,0) then
Res := ord(srSuccess)
else
Res := ord(srError); //version not supported
//debugln('got rtmisc/');
DebugLn('got rtmisc/version ( ver=' + MiscReq.FileRequest.FileName + ' )' +
' Success: ', BoolToStr((Res = ord(srSuccess)), true));
end;
mrBeginUpdate:
begin
DebugLn('got BeginUpdate');
BeginUpdate;
Res := ord(srSuccess);
end;
mrEndUpdate:
begin
DebugLn('got EndUpdate');
EndUpdate;
Res := ord(srSuccess);
end
else {Unknown request}
Res := ord(srUnknown);
end;
end;
end; //rtMisc
end;
@ -699,29 +844,25 @@ begin
// Keep after SendResponse to avoid timing issues (e.g. writing to log file):
//debugln('Just sent TLHelpResponse code: '+inttostr(Res));
if MustClose then
// On received any command:
if (fMustClose = false) and (fHide = false) then
begin
Application.ProcessMessages;
Sleep(10);
Application.Terminate;
end;
// We received mrShow:
if (MustClose=false) and (fHide=false) then
begin
Self.SendToBack;
Self.BringToFront;
Self.ShowOnTop;
// If lhelp was run with hidden parameter, we need to apply
// layout preferences once:
ApplyLayoutPreferencesOnce;
end;
if fMustClose then
begin
Close;
Application.Terminate;
end;
end;
end;
procedure THelpForm.ReadCommandLineOptions;
var
X: Integer;
X, S: Integer;
IsHandled: array[0..50] of boolean;
URL: String;
StrItem: PStringItem;
@ -741,6 +882,7 @@ begin
fServerName := ParamStrUTF8(X);
IsHandled[X] := True;
inc(X);
DebugLn('Start IPCNAME = ', fServerName);
end;
end
else if LowerCase(ParamStrUTF8(X)) = '--context' then
@ -752,6 +894,7 @@ begin
begin
IsHandled[X] := True;
inc(X);
DebugLn('Start CONTEXT = ', IntToStr(fContext));
end;
end
else if LowerCase(ParamStrUTF8(X)) = '--hide' then
@ -759,6 +902,7 @@ begin
IsHandled[X] := True;
inc(X);
fHide:=true;
DebugLn('Start HIDE = True');
end
else
begin
@ -780,15 +924,20 @@ begin
if pos('file://', FileName) = 1 then
begin
System.Delete(Filename,1,length('file://'));
S:= System.Pos('?', Filename);
if S > 0 then System.Delete(Filename, S, Length(FileName));
Filename := SetDirSeparators(Filename);
if not FileExistsUTF8(Filename) then
begin
debugln(['THelpForm.ReadCommandLineOptions file not found "',Filename,'"']);
DebugLn(['THelpForm.ReadCommandLineOptions file not found "',Filename,'"']);
continue;
end;
end;
StrItem := New(PStringItem);
// https://www.freepascal.org/docs-html/rtl/system/initialize.html
GetMem(StrItem, SizeOf(TStringItem));
Initialize(StrItem^);
StrItem^.FString := URL;
DebugLn('Start URL = ', URL);
Application.QueueAsyncCall(TDataEvent(@LateOpenURL), {%H-}PtrUInt(StrItem));
Break;
end;
@ -848,88 +997,103 @@ begin
end;
function THelpForm.OpenURL(const AURL: String; AContext: THelpContext): DWord;
function GetURLPrefix: String;
var
fPos: Integer;
begin
fPos := Pos('://', AURL);
Result := Copy(AURL, 1, fPos+2);
end;
var
fURLPrefix: String;
fContentProvider: TBaseContentProviderClass;
fRealContentProvider: TBaseContentProviderClass;
fPage: TContentTab = nil;
fFirstSameTypePage: TContentTab = nil;
I: Integer;
fIsNewPage: Boolean = false;
begin
Result := Ord(srInvalidURL);
fURLPrefix := GetURLPrefix;
fContentProvider := GetContentProvider(fURLPrefix);
if fContentProvider = nil then
begin
ShowError(Format(slhelp_CannotHandleThisTypeOfContentForUrl, [fURLPrefix, LineEnding, AURL]));
Result := Ord(srInvalidURL);
Exit;
end;
fRealContentProvider := fContentProvider.GetProperContentProvider(AURL);
if fRealContentProvider = nil then
begin
ShowError(Format(slhelp_CannotHandleThisTypeOfSubcontentForUrl, [fURLPrefix, LineEnding, AURL]));
Result := Ord(srInvalidURL);
Exit;
end;
Result := Ord(srInvalidURL);
fURLPrefix := GetUriPrefix(AURL);
fContentProvider := GetContentProvider(fURLPrefix);
if not fShowSepTabs then
for I := 0 to PageControl.PageCount-1 do
begin
if fRealContentProvider.ClassName = TContentTab(PageControl.Pages[I]).ContentProvider.ClassName then
begin
fPage := TContentTab(PageControl.Pages[I]);
if TContentTab(PageControl.Pages[I]).ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := PageControl.Pages[I];
Result := Ord(srSuccess);
end
else
Result := Ord(srInvalidFile);
Exit;
end;
end;
if fContentProvider = nil then
begin
ShowError(Format(slhelp_CannotHandleThisTypeOfContentForUrl, [fURLPrefix, LineEnding, AURL]));
Result := Ord(srInvalidURL);
Exit;
end;
if fPage = nil then
begin
// no existing page that can handle this content, so create one
fIsNewPage := true;
fPage := TContentTab.Create(PageControl);
fPage.ContentProvider := fRealContentProvider.Create(fPage, ImageList1);
fPage.ContentProvider.OnTitleChange := @ContentTitleChange;
fPage.Parent := PageControl;
SetKeyUp(fPage);
fPage.ContentProvider.LoadPreferences(fConfig);
if fPage.ContentProvider is TChmContentProvider then
fRealContentProvider := fContentProvider.GetProperContentProvider(AURL);
if fRealContentProvider = nil then
begin
ShowError(Format(slhelp_CannotHandleThisTypeOfSubcontentForUrl, [fURLPrefix, LineEnding, AURL]));
Result := Ord(srInvalidURL);
Exit;
end;
Result := Ord(srInvalidFile);
if (fUpdateCount > 0) then
begin
fLastHiddenRequest:= AURL;
//DebugLn('set fLastHiddenRequest: ', AURL);
end;
// Searching a page for loading or refreshing data
for I := 0 to PageControl.PageCount-1 do
begin
fPage := TContentTab(PageControl.Pages[I]);
if fRealContentProvider.ClassName = fPage.ContentProvider.ClassName then
begin
if fFirstSameTypePage = nil then fFirstSameTypePage:= fPage;
if fPage.ContentProvider.HasLoadedData(AURL) then // need to update data
break;
end;
fPage := nil;
end;
if (fPage = nil) and (Assigned(fFirstSameTypePage) and (not fShowSepTabs)) then
begin // Page with data not found but exists the page with same type
fPage := fFirstSameTypePage;
end;
if (fPage <> nil ) then // load or refresh a data within this page
begin
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
Result := Ord(srSuccess);
end
else
begin
fPage := nil;
Result := Ord(srInvalidFile);
end;
end;
if fPage = nil then
begin
// none existing page that can handle this content, so create one
fIsNewPage := true;
fPage := TContentTab.Create(PageControl);
fPage.ContentProvider := fRealContentProvider.Create(fPage, ImageList1, fUpdateCount);
fPage.ContentProvider.OnTitleChange := @ContentTitleChange;
//fPage.ContentProvider.OnContentComplete := @DoShowContent;
fPage.Parent := PageControl;
//SetKeyUp(fPage);
fPage.ContentProvider.LoadPreferences(fConfig);
if fPage.ContentProvider is TChmContentProvider then
(fPage.ContentProvider as TChmContentProvider).ShowStatusbar := fShowStatus;
end;
if fUpdateCount > 0 then
fPage.ContentProvider.BeginUpdate;
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
RefreshState;
Result := Ord(srSuccess);
end
else begin
Result := Ord(srInvalidURL);
if fIsNewPage then
fPage.Free;
end;
if not fHide then
ShowOnTop;
// BeginUpdate doing into Create
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
RefreshState;
Result := Ord(srSuccess);
end
else
begin
Result := Ord(srInvalidURL);
if fIsNewPage then
fPage.Free;
end;
end;
end;
@ -941,7 +1105,8 @@ begin
// context shown
fContext := -1;
Dispose(Url);
Finalize(Url^);
Freemem(Url);
RefreshState;
end;
@ -969,7 +1134,7 @@ begin
end;
end;
end
else
else
begin
en := Assigned(ActivePage);
// Show content page
@ -981,12 +1146,18 @@ begin
Visible := true;
TabsControl.Visible := true;
Splitter.Visible := true;
ActivateProvider;
end;
end;
end;
BackBttn.Enabled := en;
ForwardBttn.Enabled := en;
MiActionsGoBack.Enabled:= en;
MiActionsGoForward.Enabled:=en;
MiActionsGoHome.Enabled:=en;
MiActionsIndex.Enabled:=en;
MiActionsTOC.Enabled:=en;
MiActionsSearch.Enabled:=en;
HomeBttn.Enabled := en;
FileMenuCloseItem.Enabled := en;
ViewMenuContents.Enabled := en;
@ -1002,25 +1173,13 @@ begin
ShowMessage(AError);
end;
procedure THelpForm.SetKeyUp(AControl: TControl);
var
WCont: TWinControl absolute AControl;
i: Integer;
begin
if (AControl = nil) or not (AControl.InheritsFrom(TWinControl)) then
Exit;
for i := 0 to WCont.ControlCount-1 do
SetKeyUp(WCont.Controls[i]);
WCont.OnKeyUp:=@FormKeyUp;
end;
procedure THelpForm.BeginUpdate;
var
Tab: TContentTab;
i: Integer;
begin
Inc(fUpdateCount);
if fUpdateCount = 1 then
//WriteLn(Format('>> fUpdateCount:=%d',[fUpdateCount]));
begin
for i := 0 to PageControl.PageCount-1 do
begin
@ -1039,8 +1198,7 @@ begin
Dec(fUpdateCount);
if fUpdateCount < 0 then
fUpdateCount:=0;
if fUpdateCount = 0 then
//WriteLn(Format('<< fUpdateCount:=%d',[fUpdateCount ]));
begin
for i := 0 to PageControl.PageCount-1 do
begin
@ -1050,6 +1208,28 @@ begin
end;
end;
procedure THelpForm.ShowApp();
begin
if (fHide = false) then
begin
fMustClose:= false;
Application.Restore;
Application.BringToFront;
{$IFDEF WINDOWS}
// Go to TOC TreeView and to get focus on foreground window
KeyInput.Apply([ssCtrl]);
KeyInput.Press(VK_T);
KeyInput.UnApply([ssCtrl]);
{$ENDIF}
end;
end;
procedure THelpForm.DoShowContent(Sender: Tobject);
begin
ShowApp();
end;
{ TContentTab }
constructor TContentTab.Create(AOwner: TComponent);

15
components/chmhelp/lhelp/lhelpstrconsts.pas
View File

@ -1,4 +1,4 @@
unit lhelpstrconsts;
unit LHelpStrConsts;
{$mode objfpc}{$H+}
@ -11,12 +11,13 @@ resourcestring
slhelp_LHelpCHMFileViewerVersionCopyrightCAndrewHainesLaz = 'LHelp (CHM file viewer)%sVersion %s%sCopyright (C) Andrew Haines, %sLazarus contributors';
slhelp_Ok = 'Ok';
slhelp_PleaseEnterAURL = 'Please enter a URL';
slhelp_SupportedURLTypeS = 'Supported URL type(s): (%s)';
slhelp_SupportedURLTypeS = 'Supported URL type(s): [ %s ]';
slhelp_File = '&File';
slhelp_Open = '&Open ...';
slhelp_OpenRecent = 'Open Recent';
slhelp_OpenURL = 'Open &URL ...';
slhelp_Close = '&Close';
slhelp_Hide = '&Hide';
slhelp_EXit = 'E&xit';
slhelp_View = '&View';
slhelp_ShowContents = 'Show contents';
@ -46,6 +47,16 @@ resourcestring
slhelp_SearchResults = 'Search Results:';
slhelp_Copy = 'Copy';
slhelp_PageCannotBeFound = 'Page cannot be found!';
slhelp_CopyHtmlSource = 'Copy html source';
slhelp_CloseConfirm = 'You can use the Esc to hide Help. Are you realy want to close lHelp?';
slhelp_Actions = '&Actions';
slhelp_ActionsTOC = '&TOC';
slhelp_ActionsIndex = 'Search by &index';
slhelp_ActionsSearch = '&Search by text';
slhelp_ActionsGoHome = 'Go home';
slhelp_ActionsGoBack = 'Go back';
slhelp_ActionsGoForward = 'Go forward';
// --help
slhelp_LHelpOptions = ' LHelp options:';

9
components/chmhelp/packages/help/lazhelpchm.pas
View File

@ -20,8 +20,13 @@ unit LazHelpCHM;
interface
uses
Classes, SysUtils, LazHelpIntf, LazConfigStorage, HelpIntfs,
Dialogs, Forms, LazLoggerBase, FileUtil, LazFileUtils, LHelpControl, LResources;
Classes, SysUtils,
// LCL
LazHelpIntf, HelpIntfs, LResources, Dialogs, Forms,
// LazUtils
LazConfigStorage, LazLoggerBase, FileUtil, LazFileUtils,
// ChmHelp
LHelpControl;
const
CHMMimeType = 'application/chm';

4
components/chmhelp/packages/help/lhelpcontrol.pas
View File

@ -13,7 +13,9 @@ Currently, the only help viewer that supports this protocol is the lhelp CHM hel
interface
uses
Classes, SysUtils, LazFileUtils, LazLoggerBase, SimpleIPC, process, UTF8Process;
Classes, SysUtils, SimpleIPC, process,
// LazUtils
LazFileUtils, LazLoggerBase, UTF8Process;
const
PROTOCOL_VERSION='2'; //IDE<>LHelp communication protocol version. Please update when breaking compatibility

2
components/chmhelp/packages/idehelp/lazchmhelp.pas
View File

@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils,
// LazUtils
FileUtil, LazLogger, LazFileUtils, LazConfigStorage, UTF8Process, LazUTF8,
FileUtil, LazLoggerBase, LazFileUtils, LazConfigStorage, UTF8Process, LazUTF8,
// LCL
Controls, Forms, Dialogs, LazHelpIntf, HelpIntfs, LCLPlatformDef, InterfaceBase,
// IdeIntf