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

lhelp: replaced idle timer with asyncmethod call.

Browse Source 
git-svn-id: trunk@17153 -
This commit is contained in:
vincents 2008-10-29 15:55:13 +00:00
parent 8149dc9b66
commit 4b419e7e3c
1 changed files with 18 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
FileUtil, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus, FileUtil, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus,
BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider; BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider;
type type
@ -33,6 +33,7 @@ type
fPopUp: TPopUpMenu; fPopUp: TPopUpMenu;
fStatusBar: TStatusBar; fStatusBar: TStatusBar;
fContext: THelpContext; fContext: THelpContext;
fPendingChm: TChmReader;
protected protected
fIsUsingHistory: Boolean; fIsUsingHistory: Boolean;
fChms: TChmFileList; fChms: TChmFileList;
@ -49,7 +50,7 @@ type
procedure DoError(Error: Integer); procedure DoError(Error: Integer);
procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer); procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer);
procedure FillTOCTimer(Sender: TObject); procedure FillTOC(Data: PtrInt);
procedure IpHtmlPanelDocumentOpen(Sender: TObject); procedure IpHtmlPanelDocumentOpen(Sender: TObject);
procedure IpHtmlPanelHotChange(Sender: TObject); procedure IpHtmlPanelHotChange(Sender: TObject);
procedure PopupCopyClick(Sender: TObject); procedure PopupCopyClick(Sender: TObject);
@ -72,12 +73,6 @@ type
destructor Destroy; override; destructor Destroy; override;
end; end;
TTocTimer = class(TIdleTimer)
private
fChm: TChmReader;
end;
implementation implementation
uses ChmSpecialParser; uses ChmSpecialParser;
@ -159,7 +154,6 @@ begin
fHtml.OpenURL(Url); fHtml.OpenURL(Url);
TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URL)+'/'; TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URL)+'/';
AddHistory(Url); AddHistory(Url);
end; end;
@ -171,11 +165,10 @@ end;
procedure TChmContentProvider.NewChmOpened(ChmFileList: TChmFileList; procedure TChmContentProvider.NewChmOpened(ChmFileList: TChmFileList;
Index: Integer); Index: Integer);
var
TImer: TTocTimer;
begin begin
if Index = 0 then begin if Index = 0 then begin
fContentsTree.Items.Clear; fContentsTree.Items.Clear;
fPendingChm := ChmFileList.Chm[Index];
if fContext > -1 then begin if fContext > -1 then begin
DoLoadContext(fContext); DoLoadContext(fContext);
fContext := -1; fContext := -1;
@ -187,37 +180,29 @@ begin
if ChmFileList.Chm[Index].Title = '' then if ChmFileList.Chm[Index].Title = '' then
ChmFileList.Chm[Index].Title := ExtractFileName(ChmFileList.FileName[Index]); ChmFileList.Chm[Index].Title := ExtractFileName(ChmFileList.FileName[Index]);
// Fill the table of contents. This actually works very well // Fill the table of contents. This actually works very well
Timer := TTocTimer.Create(fHtml);
if ChmFileList.ObjectExists(ChmFileList.Chm[Index].TOCFile) + ChmFileList.ObjectExists(ChmFileList.Chm[Index].IndexFile)> 25000 then
Timer.Interval := 500
else
Timer.Interval := 5;
Timer.OnTimer := @FillTOCTimer;
Timer.fChm := ChmFileList.Chm[Index];
Timer.Enabled := True;
fContentsTree.Visible := False; fContentsTree.Visible := False;
end; end;
procedure TChmContentProvider.FillTOCTimer(Sender: TObject); procedure TChmContentProvider.FillTOC(Data: PtrInt);
var var
Stream: TMemoryStream; Stream: TMemoryStream;
fChm: TChmReader; fChm: TChmReader;
ParentNode: TTreeNode; ParentNode: TTreeNode;
begin begin
if fFillingToc = True then begin if fFillingToc = True then begin
TTimer(Sender).Interval := 40; Application.QueueAsyncCall(@FillToc, Data);
exit; exit;
end; end;
fFillingToc := True; fFillingToc := True;
fStopTimer := False;
fContentsTree.Visible := False; fContentsTree.Visible := False;
fChm := TTocTimer(Sender).fChm; fChm := TChmReader(Data);
TTocTimer(Sender).Free; writeln('Start: ',FormatDateTime('hh:nn:ss.zzz', Now));
if fChm <> nil then begin if fChm <> nil then begin
ParentNode := fContentsTree.Items.AddChildObject(nil, fChm.Title, fChm); ParentNode := fContentsTree.Items.AddChildObject(nil, fChm.Title, fChm);
Stream := TMemoryStream(fchm.GetObject(fChm.TOCFile)); Stream := TMemoryStream(fchm.GetObject(fChm.TOCFile));
if Stream <> nil then begin if Stream <> nil then begin
Stream.position := 0; Stream.position := 0;
writeln('Stream read: ',FormatDateTime('hh:nn:ss.zzz', Now));
with TContentsFiller.Create(fContentsTree, Stream, @fStopTimer) do begin with TContentsFiller.Create(fContentsTree, Stream, @fStopTimer) do begin
DoFill(ParentNode); DoFill(ParentNode);
Free; Free;
@ -240,17 +225,24 @@ begin
fContentsTree.Visible := True; fContentsTree.Visible := True;
writeln('Eind: ',FormatDateTime('hh:nn:ss.zzz', Now));
fFillingToc := False; fFillingToc := False;
fStopTimer := False;
end; end;
procedure TChmContentProvider.IpHtmlPanelDocumentOpen(Sender: TObject); procedure TChmContentProvider.IpHtmlPanelDocumentOpen(Sender: TObject);
var
AChm: TChmReader;
begin begin
// StatusBar1.Panels.Items[1] := fHtml.DataProvider.; // StatusBar1.Panels.Items[1] := fHtml.DataProvider.;
if fIsUsingHistory = False then if fIsUsingHistory = False then
AddHistory(TIpChmDataProvider(fHtml.DataProvider).CurrentPage) AddHistory(TIpChmDataProvider(fHtml.DataProvider).CurrentPage)
else fIsUsingHistory := False; else fIsUsingHistory := False;
if fPendingChm<>nil then
begin
AChm := fPendingChm;
fPendingChm := nil;
Application.QueueAsyncCall(@FillToc, PtrInt(AChm));
end;
end; end;
procedure TChmContentProvider.IpHtmlPanelHotChange(Sender: TObject); procedure TChmContentProvider.IpHtmlPanelHotChange(Sender: TObject);