paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-02 21:23:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some more lhelp fixes loading chm's from lazarus works properly now when two chms are opened

Browse Source 
git-svn-id: trunk@17666 -
This commit is contained in:
andrew 2008-12-03 01:03:46 +00:00
parent 707ab26207
commit 441f211cf7
2 changed files with 34 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -46,7 +46,7 @@ type
function MakeURI(AUrl: String; AChm: TChmReader): String; function MakeURI(AUrl: String; AChm: TChmReader): String;
procedure AddHistory(URL: String); procedure AddHistory(URL: String);
procedure DoOpenChm(AFile: String); procedure DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
procedure DoCloseChm; procedure DoCloseChm;
procedure DoLoadContext(Context: THelpContext); procedure DoLoadContext(Context: THelpContext);
procedure DoLoadUri(Uri: String; AChm: TChmReader = nil); procedure DoLoadUri(Uri: String; AChm: TChmReader = nil);
@ -135,27 +135,40 @@ begin
Inc(fHistoryIndex); Inc(fHistoryIndex);
end; end;
procedure TChmContentProvider.DoOpenChm(AFile: String); type
TCHMHack = class(TChmFileList)
end;
procedure TChmContentProvider.DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
begin begin
if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit; if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit;
DoCloseChm; if ACloseCurrent then DoCloseChm;
if not FileExistsUTF8(AFile) or DirectoryExistsUTF8(AFile) then if not FileExistsUTF8(AFile) or DirectoryExistsUTF8(AFile) then
begin begin
Exit; Exit;
end; end;
try if fChms = nil then
fChms := TChmFileList.Create(AFile); begin
if Not(fChms.Chm[0].IsValidFile) then begin try
fChms := TChmFileList.Create(AFile);
if Not(fChms.Chm[0].IsValidFile) then begin
FreeAndNil(fChms);
//DoError(INVALID_FILE_TYPE);
Exit;
end;
TIpChmDataProvider(fHtml.DataProvider).Chm := fChms;
except
FreeAndNil(fChms); FreeAndNil(fChms);
//DoError(INVALID_FILE_TYPE); //DoError(INVALID_FILE_TYPE);
Exit; Exit;
end; end;
TIpChmDataProvider(fHtml.DataProvider).Chm := fChms; end
except else
FreeAndNil(fChms); begin
//DoError(INVALID_FILE_TYPE); TCHMHack(fChms).OpenNewFile(AFile);
Exit; WriteLn('Loading new chm: ', AFile);
end; end;
if fChms = nil then Exit; if fChms = nil then Exit;
fHistoryIndex := -1; fHistoryIndex := -1;
@ -582,6 +595,7 @@ var
fURL: String = ''; fURL: String = '';
fPos: Integer; fPos: Integer;
FileIndex: Integer; FileIndex: Integer;
LoadTOC: Boolean;
begin begin
Result := False; Result := False;
fFile := Copy(AUrl,8, Length(AURL)); fFile := Copy(AUrl,8, Length(AURL));
@ -591,9 +605,8 @@ begin
fFile := Copy(fFIle, 1, fPos-1); fFile := Copy(fFIle, 1, fPos-1);
end; end;
//writeln(fURL); //writeln(fURL);
if fChms <> nil then LoadTOC := (fChms = nil) or (fChms.IndexOf(fFile) < 0);
fChms.OnOpenNewFile := nil; DoOpenChm(fFile, False);
DoOpenChm(fFile);
FileIndex := fChms.IndexOf(fFile); FileIndex := fChms.IndexOf(fFile);
if fURL <> '' then if fURL <> '' then
DoLoadUri(MakeURI(fURL, fChms.Chm[FileIndex])) DoLoadUri(MakeURI(fURL, fChms.Chm[FileIndex]))
@ -601,8 +614,11 @@ begin
GoHome; GoHome;
Result := True; Result := True;
Application.ProcessMessages; if LoadTOC and (FileIndex = 0) then
Application.QueueAsyncCall(@FillToc, PtrInt(fChms.Chm[FileIndex])); begin
Application.ProcessMessages;
Application.QueueAsyncCall(@FillToc, PtrInt(fChms.Chm[FileIndex]));
end;
fChms.OnOpenNewFile := @NewChmOpened; fChms.OnOpenNewFile := @NewChmOpened;
end; end;

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

@ -310,6 +310,8 @@ begin
fNewPage := TContentTab.Create(PageControl); fNewPage := TContentTab.Create(PageControl);
fNewPage.ContentProvider := fRealContentProvider.Create(fNewPage); fNewPage.ContentProvider := fRealContentProvider.Create(fNewPage);
fNewPage.Parent := PageControl; fNewPage.Parent := PageControl;
ShowOnTop;
if fNewPage.ContentProvider.LoadURL(AURL, AContext) then if fNewPage.ContentProvider.LoadURL(AURL, AContext) then
PageControl.ActivePage := fNewPage; PageControl.ActivePage := fNewPage;