paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-05 08:57:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

added THelpDatabase.OnFindViewer

Browse Source 
git-svn-id: trunk@22027 -
This commit is contained in:
mattias 2009-10-04 22:56:17 +00:00
parent bc1151ad6e
commit c6da6d978e
1 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/lazhelpintf.pas
View File

@ -284,12 +284,17 @@ type
THelpDatabases = class;
THelpViewer = class;
TOnHelpDBFindViewer =
function(HelpDB: THelpDatabase; const MimeType: string;
var ErrMsg: string; out Viewer: THelpViewer): TShowHelpResult of object;
THelpDatabase = class(TComponent)
private
FAutoRegister: boolean;
FBasePathObject: TObject;
FID: THelpDatabaseID;
FDatabases: THelpDatabases;
FOnFindViewer: TOnHelpDBFindViewer;
FRefCount: integer;
FSearchItems: TFPList;
FSupportedMimeTypes: TStrings;
@ -353,6 +358,7 @@ type
property BasePathObject: TObject read FBasePathObject write FBasePathObject;
property TOCNode: THelpNode read FTOCNode write FTOCNode;
property AutoRegister: boolean read FAutoRegister write SetAutoRegister;
property OnFindViewer: TOnHelpDBFindViewer read FOnFindViewer write FOnFindViewer;
end;
THelpDatabaseClass = class of THelpDatabase;
@ -1068,6 +1074,11 @@ var
Viewers: TList;
begin
Viewer:=nil;
if Assigned(OnFindViewer) then begin
Result:=OnFindViewer(Self,MimeType,ErrMsg,Viewer);
exit;
end;
Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType);
try
if (Viewers=nil) or (Viewers.Count=0) then begin