added Help to TApplication, disable it with Application.Navigation-[anoF1ForHelp]

git-svn-id: trunk@9281 -
This commit is contained in:
mattias 2006-05-13 17:07:25 +00:00
parent 0ee6a67e72
commit 336c22deda
8 changed files with 56 additions and 28 deletions

View File

@ -1174,6 +1174,8 @@ type
function ParentDestroyingHandle: boolean;
function ParentHandlesAllocated: boolean; virtual;
procedure InitiateAction; virtual;
procedure ShowHelp; virtual;
function HasHelp: Boolean;
public
// Event lists
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;

View File

@ -39,7 +39,7 @@ interface
uses
Classes, SysUtils, Math, LCLStrConsts, LCLType, LCLProc, LCLIntf,
InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages, CustomTimer,
ActnList, ClipBrd, CustApp, LCLClasses, Controls;
ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls;
type
TProcedure = procedure;
@ -849,7 +849,8 @@ type
TApplicationNavigationOption = (
anoTabToSelectNext,
anoReturnForDefaultControl,
anoEscapeForCancelControl
anoEscapeForCancelControl,
anoF1ForHelp
);
TApplicationNavigationOptions = set of TApplicationNavigationOption;
@ -984,6 +985,7 @@ type
function HelpKeyword(Sender: TObject; const Position: TPoint;
const Keyword: String): Boolean;
function HelpKeyword(const Keyword: String): Boolean;
procedure ShowHelpForObjecct(Sender: TObject);
procedure HideAllFormsWithStayOnTop;
function IsWaiting: boolean;
procedure CancelHint;

View File

@ -28,6 +28,8 @@
or use the LCL help system in lazhelpintf.pas.
The THTMLHelpDatabase and THTMLBrowserHelpViewer in lazhelphtml.pas use the
LCL help system.
To create your own help system, implement a descendant of THelpManager.
}
unit HelpIntfs;

View File

@ -95,7 +95,7 @@ begin
FOnIdle := nil;
FIcon := nil;
FNavigation := [anoTabToSelectNext,anoReturnForDefaultControl,
anoEscapeForCancelControl];
anoEscapeForCancelControl,anoF1ForHelp];
ApplicationActionComponent:=Self;
OnMenuPopupHandler:=@MenuPopupHandler;
@ -517,7 +517,7 @@ end;
------------------------------------------------------------------------------}
function TApplication.ValidateHelpSystem: Boolean;
begin
Result:=false;
Result:=HelpManager<>nil;
end;
{------------------------------------------------------------------------------
@ -924,8 +924,7 @@ function TApplication.HelpContext(Sender: TObject; const Position: TPoint;
Context: THelpContext): Boolean;
begin
if ValidateHelpSystem then begin
Result := true;
//HelpSystem.ShowContextHelp(Context, GetCurrentHelpFile);
Result := ShowHelpOrErrorForContext('',Context)=shrSuccess;
end else
Result := false;
end;
@ -942,8 +941,7 @@ function TApplication.HelpKeyword(Sender: TObject; const Position: TPoint;
const Keyword: String): Boolean;
begin
if ValidateHelpSystem then begin
Result := true;
//HelpSystem.ShowHelp(Keyword, GetCurrentHelpFile);
Result := ShowHelpOrErrorForKeyword('',Keyword)=shrSuccess;
end else
Result := false;
end;
@ -956,6 +954,13 @@ begin
Result:=HelpKeyword(nil,Point(0,0),Keyword);
end;
procedure TApplication.ShowHelpForObjecct(Sender: TObject);
begin
if Sender is TControl then begin
TControl(Sender).ShowHelp;
end;
end;
{------------------------------------------------------------------------------
procedure TApplication.HideAllFormsWithStayOnTop;
------------------------------------------------------------------------------}
@ -1257,6 +1262,8 @@ begin
i:=FApplicationHandlers[ahtKeyDownAfter].Count;
while FApplicationHandlers[ahtKeyDownAfter].NextDownIndex(i) do
TKeyEvent(FApplicationHandlers[ahtKeyDownAfter][i])(Sender,Key,Shift);
if (Shift=[]) and (Key=VK_F1) then
ShowHelpForObjecct(Sender);
end;
procedure TApplication.ControlKeyDown(Sender: TObject; var Key: Word;

View File

@ -3055,6 +3055,30 @@ begin
if ActionLink <> nil then ActionLink.Update;
end;
procedure TControl.ShowHelp;
begin
if HelpType=htContext then begin
if HelpContext<>0 then begin
Application.HelpContext(Self,ClientToScreen(Point(0,0)),HelpContext);
exit;
end;
end else begin
if HelpKeyword<>'' then begin
Application.HelpKeyword(Self,ClientToScreen(Point(0,0)),HelpKeyword);
exit;
end;
end;
if Parent<>nil then Parent.ShowHelp;
end;
function TControl.HasHelp: Boolean;
begin
if HelpType=htContext then
Result:=HelpContext<>0
else
Result:=HelpKeyword<>'';
end;
{------------------------------------------------------------------------------
procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);

View File

@ -1673,29 +1673,11 @@ end;
This function is called by the interface.
------------------------------------------------------------------------------}
procedure TCustomForm.IntfHelp(AComponent: TComponent);
var
AControl: TControl;
begin
if csDesigning in ComponentState then exit;
if AComponent is TControl then begin
AControl:=TControl(AComponent);
repeat
if AControl.HelpType=htContext then begin
if AControl.HelpContext<>0 then begin
Application.HelpContext(Self,AControl.ClientToScreen(Point(0,0)),
AControl.HelpContext);
exit;
end;
end else begin
if AControl.HelpKeyword<>'' then begin
Application.HelpKeyword(Self,AControl.ClientToScreen(Point(0,0)),
AControl.HelpKeyword);
exit;
end;
end;
AControl:=AControl.Parent;
until AControl=nil;
TControl(AComponent).ShowHelp;
end else begin
DebugLn('TCustomForm.IntfHelp TODO help for ',DbgSName(AComponent));
end;

View File

@ -79,9 +79,16 @@ type
property BrowserParams: string read FBrowserParams write SetBrowserParams;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('System',[THTMLHelpDatabase,THTMLBrowserHelpViewer]);
end;
{ THTMLHelpDatabase }
procedure THTMLHelpDatabase.SetBaseURL(const AValue: string);

View File

@ -42,7 +42,8 @@ uses
Menus, Buttons, StdCtrls, ExtCtrls, ComCtrls, Forms, Grids, Controls,
Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter, ExtDlgs,
StdActns, DBCtrls, DBGrids, DBActns, EditBtn, ActnList, FileCtrl, ButtonPanel,
LResources, XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox;
LResources, XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox,
LazHelpHTML;
procedure Register;
@ -80,6 +81,7 @@ begin
RegisterUnit('ColorBox',@ColorBox.Register);
RegisterUnit('ButtonPanel',@ButtonPanel.Register);
RegisterUnit('LResources',@LResources.Register);
RegisterUnit('LazHelpHTML',@LazHelpHTML.Register);
end;
end.