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

chmhelp: fixed mem leak

Browse Source 
git-svn-id: trunk@31314 -
This commit is contained in:
mattias 2011-06-20 19:42:25 +00:00
parent dc24fe5d73
commit d400a7e51a
1 changed files with 32 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/chmhelp/packages/idehelp/chmlcl.pas
View File

@ -5,31 +5,38 @@ unit ChmLcl;
interface interface
uses uses
LazHelpIntf, HelpFPDoc; Classes, LazHelpIntf, HelpFPDoc;
const const
sLclUnits = 'LCL - Lazarus component library'; sLclUnits = 'LCL - Lazarus component library';
type
{ TLclChmHelpDatabase }
TLclChmHelpDatabase = class(TFPDocHTMLHelpDatabase)
private
FBaseURL: THelpBaseURLObject;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
procedure RegisterLclHelpDatabase; procedure RegisterLclHelpDatabase;
var var
LCLHelpDatabase: TFPDocHTMLHelpDatabase = nil; LCLHelpDatabase: TLclChmHelpDatabase = nil;
implementation implementation
procedure RegisterLclHelpDatabase; procedure RegisterLclHelpDatabase;
var var
FPDocNode: THelpNode; FPDocNode: THelpNode;
BaseURL: THelpBaseURLObject;
DirItem: THelpDBISourceDirectory; DirItem: THelpDBISourceDirectory;
begin begin
if Assigned(LCLHelpDatabase) then Exit; if Assigned(LCLHelpDatabase) then Exit;
LCLHelpDatabase := TFPDocHTMLHelpDatabase( LCLHelpDatabase := TLclChmHelpDatabase(
HelpDatabases.CreateHelpDatabase(sLclUnits, TFPDocHTMLHelpDatabase, True)); HelpDatabases.CreateHelpDatabase(sLclUnits, TLclChmHelpDatabase, True));
BaseURL := THelpBaseURLObject.Create;
BaseURL.BaseURL := 'lcl.chm://';
LCLHelpDatabase.BasePathObject := BaseURL;
// FPDoc nodes for units in the LCL // FPDoc nodes for units in the LCL
FPDocNode := THelpNode.CreateURL(LCLHelpDatabase, FPDocNode := THelpNode.CreateURL(LCLHelpDatabase,
@ -41,5 +48,21 @@ begin
LCLHelpDatabase.RegisterItem(DirItem); LCLHelpDatabase.RegisterItem(DirItem);
end; end;
{ TLclChmHelpDatabase }
constructor TLclChmHelpDatabase.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FBaseURL := THelpBaseURLObject.Create;
FBaseURL.BaseURL := 'lcl.chm://';
BasePathObject := FBaseURL;
end;
destructor TLclChmHelpDatabase.Destroy;
begin
FBaseURL.Free;
inherited Destroy;
end;
end. end.