1 unit chmcontentprovider;
2 
3 {
4   Graphical CHM help content provider.
5   Responsible for loading TOC, providing search etc.
6 }
7 
8 {$mode objfpc}{$H+}
9 
10 {$Note Compiling lhelp with search support}
11 {$DEFINE CHM_SEARCH}
12 
13 {$IF FPC_FULLVERSION>=20400}
14 {$Note Compiling lhelp *with* binary index and toc support}
15 // CHMs can have both binary and text Table of Contents and index
16 {$DEFINE CHM_BINARY_INDEX_TOC}
17 {$endif}
18 
19 
20 {off $DEFINE CHM_DEBUG_TIME}
21 
22 
23 interface
24 
25 uses
26   Classes, SysUtils, ChmReader,
27   // LCL
28   LCLIntf, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Menus,
29   // LazUtils
30   LazFileUtils, LazUTF8, Laz2_XMLCfg,
31   // ChmHelp
32   IpHtml, BaseContentProvider, FileContentProvider, ChmDataProvider, lhelpstrconsts;
33 
34 const
35   DefaultCHMContentTitle = '[unknown]';
36 
37 type
38 
39   { TChmContentProvider }
40 
41   TChmContentProvider = class(TFileContentProvider)
42   private
43     fUpdateURI: String;
44     fTabsControl: TPageControl;
45       fContentsTab: TTabSheet;
46        fContentsPanel: TPanel;
47          fContentsTree: TTreeView;
48       fIndexTab: TTabSheet;
49         fIndexEdit: TLabeledEdit;
50         fIndexView: TTreeView;//TListView;
51       fSearchTab: TTabSheet;
52         fKeywordLabel: TLabel;
53         fKeywordCombo: TComboBox;
54         fSearchBtn: TButton;
55         fResultsLabel: TLabel;
56         fSearchResults: TTreeView;
57     fSplitter: TSplitter;
58     fHtml: TIpHtmlPanel;
59     fPopUp: TPopUpMenu;
60     fStatusBar: TStatusBar;
61     fContext: THelpContext;
GetShowStatusbarnull62     function GetShowStatusbar: Boolean;
63     procedure SetShowStatusbar(AValue: Boolean);
64   protected
65     fIsUsingHistory: Boolean;
66     fChms: TChmFileList;
67     fHistory: TStringList;
68     fHistoryIndex: Integer;
69     fStopTimer: Boolean;
70     fFillingToc: Boolean;
71     fFillingIndex: Boolean;
72     fActiveChmTitle: String;
73     FLoadingSearchURL: Boolean; // use this to try to highlight search terms
74 
MakeURInull75     function  MakeURI(AUrl: String; AChm: TChmReader): String;
76 
77     procedure BeginUpdate; override;
78     procedure EndUpdate; override;
79     procedure AddHistory(URL: String);
80     procedure DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
81     procedure DoCloseChm;
82     procedure DoLoadContext(Context: THelpContext);
83     procedure DoLoadUri(Uri: String; AChm: TChmReader = nil);
84     procedure DoError({%H-}Error: Integer);
85     procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer);
86     procedure LoadingHTMLStream(var AStream: TStream);
87 
88     // Queue TOC fill action for later processing
89     procedure QueueFillToc(AChm: TChmReader);
90     // Fills table of contents (and index for main file)
91     procedure FillTOC(Data: PtrInt);
92     procedure IpHtmlPanelDocumentOpen(Sender: TObject);
93     procedure IpHtmlPanelHotChange(Sender: TObject);
94     procedure IpHtmlPanelHotClick(Sender: TObject);
95     procedure PopupCopyClick(Sender: TObject);
96     procedure PopupCopySourceClick(Sender: TObject);
97     procedure ContentsTreeSelectionChanged(Sender: TObject);
98     procedure IndexViewDblClick(Sender: TObject);
99     procedure TreeViewStopCollapse(Sender: TObject; {%H-}Node: TTreeNode; var AllowCollapse: Boolean);
100     procedure ViewMenuContentsClick(Sender: TObject);
101     procedure UpdateTitle;
102     procedure SetTitle(const AValue: String); override;
103     procedure SearchEditChange(Sender: TObject);
104     procedure TOCExpand(Sender: TObject; Node: TTreeNode);
105     procedure TOCCollapse(Sender: TObject; Node: TTreeNode);
106     procedure SelectTreeItemFromURL(AUrl: String);
107     {$IFDEF CHM_SEARCH}
108     procedure SearchButtonClick(Sender: TObject);
109     procedure SearchResultsDblClick(Sender: TObject);
110     procedure SearchComboKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
111     procedure GetTreeNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
112     {$ENDIF}
113   public
114     procedure LoadPreferences(ACfg: TXMLConfig); override;
115     procedure SavePreferences(ACfg: TXMLConfig); override;
116   public
CanGoBacknull117     function CanGoBack: Boolean; override;
CanGoForwardnull118     function CanGoForward: Boolean; override;
GetHistorynull119     function GetHistory: TStrings; override;
LoadURLnull120     function LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; override;
121     procedure GoHome; override;
122     procedure GoBack; override;
123     procedure GoForward; override;
124     property TabsControl: TPageControl read fTabsControl;
125     property Splitter: TSplitter read fSplitter;
126     property ShowStatusbar: Boolean read GetShowStatusbar write SetShowStatusbar;
GetProperContentProvidernull127     class function GetProperContentProvider(const {%H-}AURL: String): TBaseContentProviderClass; override;
128 
129     constructor Create(AParent: TWinControl; AImageList: TImageList); override;
130     destructor Destroy; override;
131   end;
132 
133 implementation
134 
135 uses
136   clipbrd,
137   ChmSpecialParser{$IFDEF CHM_SEARCH}, chmFIftiMain{$ENDIF}, chmsitemap,
138   LCLType, SAX_HTML, Dom, DOM_HTML, HTMWrite, LConvEncoding;
139 
140 type
141 
142   { THTMLWordHighlighter }
143 
144   THTMLWordHighlighter = class
145   private
146     Doc: THTMLDocument;
147     Words: TStrings;
148     Color: String;
149     procedure ScanSubNodes(ADomNode: TDOMNode);
150     procedure CheckTextNode(var ATextNode: TDomNode);
151   public
152     constructor Create(AHTMLDoc: THTMLDocument);
153     procedure HighlightWords(AWords: TStrings; AColor: String);
154   end;
155 
156 { THTMLWordHighlighter }
157 
158 procedure THTMLWordHighlighter.ScanSubNodes(ADomNode: TDOMNode);
159 
160 var
161   CurNode: TDomNode;
162 begin
163   CurNode := ADomNode;
164   while CurNode <> nil do
165   begin
166     if CurNode.HasChildNodes then
167       ScanSubNodes(CurNode.FirstChild);
168 
169     if CurNode.NodeType = TEXT_NODE then
170       CheckTextNode(CurNode);
171 
172     CurNode := CurNode.NextSibling;
173   end;
174 end;
175 
176 procedure THTMLWordHighlighter.CheckTextNode(var ATextNode: TDomNode);
177 var
178   i: Integer;
179   fPos: Integer;
180   WordStart,
181   After: TDOMText;
182   Span: TDomElement;
183   aWord: String;
184   Parent: TDomNode;
185 begin
186    Parent := AtextNode.ParentNode;
187    for i := 0 to Words.Count-1 do
188    begin
189      aWord := Words[i];
190      fPos := Pos(aWord, LowerCase(ATextNode.TextContent));
191      while fpos > 0 do
192      begin
193        WordStart:= TDOMText(ATextNode).SplitText(fPos-1);
194        After := WordStart.SplitText(Length(aword));
195        Span := doc.CreateElement('span');
196        Span.SetAttribute('style', 'color:'+Color+';background-color:lightgray');
197        Parent.InsertBefore(Span, After);
198        Span.AppendChild(WordStart);
199 
200        // or we'll keep finding our new node again and again
201        ATextNode := After;
202 
203        fPos := Pos(aWord, ATextNode.TextContent);
204      end;
205    end;
206 end;
207 
208 constructor THTMLWordHighlighter.Create(AHTMLDoc: THTMLDocument);
209 begin
210   Doc := AHTMLDoc;
211 end;
212 
213 procedure THTMLWordHighlighter.HighlightWords(AWords: TStrings; AColor: String);
214 var
215   Elem: TDOMNode;
216 begin
217   Words := AWords;
218   Color := AColor;
219   Elem := Doc.DocumentElement.FirstChild;
220 
221   ScanSubNodes(Elem);
222 
223 end;
224 
225 function GetURIFileName(AURI: String): String;
226 var
227   FileStart,
228   FileEnd: Integer;
229 begin
230   FileStart := Pos(':', AURI)+1;
231   FileEnd := Pos('::', AURI);
232 
233   Result := Copy(AURI, FileStart, FileEnd-FileStart);
234 end;
235 
236 function GetURIURL(AURI: String): String;
237 var
238   URLStart: Integer;
239 begin
240   URLStart := Pos('::', AURI) + 2;
241   Result := Copy(AURI, URLStart, Length(AURI));
242 end;
243 
244 function ChmURI(AUrl: String; AFileName: String): String;
245 var
246   FileNameNoPath: String;
247 begin
248   Result := AUrl;
249   if Pos('ms-its:', Result) > 0 then
250     Exit;
251   FileNameNoPath := ExtractFileName(AFileName);
252 
253   Result := 'ms-its:'+FileNameNoPath+'::'+AUrl;
254 end;
255 
256 { TChmContentProvider }
257 
GetShowStatusbarnull258 function TChmContentProvider.GetShowStatusbar: Boolean;
259 begin
260   Result := fStatusbar.Visible;
261 end;
262 
263 procedure TChmContentProvider.SetShowStatusbar(AValue: Boolean);
264 begin
265   fStatusbar.Visible := AValue;
266 end;
267 
MakeURInull268 function TChmContentProvider.MakeURI ( AUrl: String; AChm: TChmReader ) : String;
269 var
270   ChmIndex: Integer;
271 begin
272   ChmIndex := fChms.IndexOfObject(AChm);
273 
274   Result := ChmURI(AUrl, fChms.FileName[ChmIndex]);
275 end;
276 
277 procedure TChmContentProvider.BeginUpdate;
278 begin
279   inherited BeginUpdate;
280   fContentsTree.BeginUpdate;
281   fIndexView.BeginUpdate;
282 end;
283 
284 procedure TChmContentProvider.EndUpdate;
285 begin
286   inherited EndUpdate;
287   fContentsTree.EndUpdate;
288   fIndexView.EndUpdate;
289   if not IsUpdating then
290   begin
291     if fUpdateURI <> '' then
292       DoLoadUri(fUpdateURI);
293     fUpdateURI:='';
294     if Title=DefaultCHMContentTitle then
295       UpdateTitle;
296   end;
297 end;
298 
299 procedure TChmContentProvider.AddHistory(URL: String);
300 begin
301   if fHistoryIndex < fHistory.Count then
302   begin
303     while fHistory.Count-1 > fHistoryIndex do
304       fHistory.Delete(fHistory.Count-1);
305   end;
306 
307   fHistory.Add(URL);
308   Inc(fHistoryIndex);
309 end;
310 
311 type
312   TCHMHack = class(TChmFileList)
313   end;
314 
315 procedure TChmContentProvider.DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
316 begin
317   if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit;
318   if ACloseCurrent then DoCloseChm;
319   if not FileExistsUTF8(AFile) or DirectoryExistsUTF8(AFile) then
320   begin
321     Exit;
322   end;
323   if fChms = nil then
324   begin
325     try
326       fChms := TChmFileList.Create(Utf8ToSys(AFile));
327       if Not(fChms.Chm[0].IsValidFile) then
328       begin
329         FreeAndNil(fChms);
330         //DoError(INVALID_FILE_TYPE);
331         Exit;
332       end;
333       TIpChmDataProvider(fHtml.DataProvider).Chm := fChms;
334     except
335       FreeAndNil(fChms);
336       //DoError(INVALID_FILE_TYPE);
337       Exit;
338     end;
339   end
340   else
341   begin
342     TCHMHack(fChms).OpenNewFile(AFile);
343     //WriteLn('Loading new chm: ', AFile);
344   end;
345 
346   if fChms = nil then Exit;
347 
348   fHistoryIndex := -1;
349   fHistory.Clear;
350 
351   // Code here has been moved to the OpenFile handler
352 
353   UpdateTitle;
354 end;
355 
356 procedure TChmContentProvider.DoCloseChm;
357 var
358   i : integer;
359 begin
360   fStopTimer := True;
361   if assigned(fChms) then
362   begin
363     for i := 0 to fChms.Count -1 do
364       fChms.Chm[i].Free;
365   end;
366   FreeAndNil(fChms);
367   UpdateTitle;
368 end;
369 
370 procedure TChmContentProvider.DoLoadContext(Context: THelpContext);
371 var
372  Str: String;
373 begin
374   if fChms = nil then exit;
375   Str := fChms.Chm[0].GetContextUrl(Context);
376   if Str <> '' then DoLoadUri(Str, fChms.Chm[0]);
377 end;
378 
379 procedure TChmContentProvider.DoLoadUri(Uri: String; AChm: TChmReader = nil);
380 var
381   ChmIndex: Integer;
382   NewUrl: String;
383   FilteredURL: String;
384   fPos: Integer;
385   StartTime: TDateTime;
386   EndTime: TDateTime;
387   Time: String;
388 begin
389   if (fChms = nil) and (AChm = nil) then exit;
390   fStatusBar.SimpleText := Format(slhelp_Loading, [Uri]);
391   Application.ProcessMessages;
392   StartTime := Now;
393 
394   fPos := Pos('#', Uri);
395   if fPos > 0 then
396     FilteredURL := Copy(Uri, 1, fPos -1)
397   else
398     FilteredURL := Uri;
399 
400   if fChms.ObjectExists(FilteredURL, AChm) = 0 then
401   begin
402     fStatusBar.SimpleText := Format(slhelp_NotFound, [URI]);
403     Exit;
404   end;
405   if (Pos('ms-its', Uri) = 0) and (AChm <> nil) then
406   begin
407     ChmIndex := fChms.IndexOfObject(AChm);
408     NewUrl := ExtractFileName(fChms.FileName[ChmIndex]);
409     NewUrl := 'ms-its:'+NewUrl+'::/'+Uri;
410     Uri := NewUrl;
411   end;
412 
413   if not IsUpdating then
414   begin
415 
416     fIsUsingHistory := True;
417     fHtml.OpenURL(Uri);
418     TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URI)+'/';
419 
420     AddHistory(Uri);
421     EndTime := Now;
422 
423     Time := INtToStr(DateTimeToTimeStamp(EndTime).Time - DateTimeToTimeStamp(StartTime).Time);
424     fStatusBar.SimpleText := Format(slhelp_LoadedInMs, [Uri, Time]);
425 
426   end
427   else
428   begin
429     // We are updating. Save this to load at end of update. or if there is already a request overwrite it so only the last is loaded
430     fUpdateURI:= Uri;
431   end;
432 end;
433 
434 
435 procedure TChmContentProvider.DoError(Error: Integer);
436 begin
437   //what to do with these errors?
438   //INVALID_FILE_TYPE;
439 end;
440 
441 procedure TChmContentProvider.NewChmOpened(ChmFileList: TChmFileList;
442   Index: Integer);
443 begin
444   if Index = 0 then
445   begin
446     if fContext > -1 then
447     begin
448       DoLoadContext(fContext);
449       fContext := -1;
450     end
451     else if ChmFileList.Chm[Index].DefaultPage <> '' then
452     begin
453       DoLoadUri(MakeURI(ChmFileList.Chm[Index].DefaultPage, ChmFileList.Chm[Index]));
454     end;
455   end;
456   if ChmFileList.Chm[Index].Title = '' then
457     ChmFileList.Chm[Index].Title := ExtractFileName(ChmFileList.FileName[Index]);
458 
459   // Fill the table of contents.
460   if Index <> 0 then
461     QueueFillToc(ChmFileList.Chm[Index]);
462 end;
463 
464 procedure TChmContentProvider.LoadingHTMLStream(var AStream: TStream);
465 var
466   Doc: THTMLDocument;
467   NewStream: TMemoryStream;
468   Highlighter: THTMLWordHighlighter;
469   Words: TStringList;
470   UseOrigStream: Boolean;
471 begin
472   if not FLoadingSearchURL then
473     Exit;
474   // load html and add tags to highlight words then save back to stream
475   NewStream := TMemoryStream.Create;
476 
477   Words := TStringList.Create;
478   Words.Delimiter:=' ';
479   Words.DelimitedText:=fKeywordCombo.Text;
480 
481   Doc:=nil;
482   try
483     UseOrigStream := True;
484     ReadHTMLFile(Doc, AStream);
485     Highlighter := THTMLWordHighlighter.Create(Doc);
486     Highlighter.HighlightWords(Words, 'red');
487     WriteHTMLFile(Doc, NewStream);
488     UseOrigStream := False;
489   finally
490     try
491       Doc.Free;
492       Highlighter.Free;
493     except
494       UseOrigStream := True;
495     end;
496   end;
497 
498   Words.Free;
499 
500   if not UseOrigStream then
501   begin
502     AStream.Free;
503     AStream := NewStream;
504     NewStream.Position:=0;
505   end
506   else
507     NewStream.Free;
508 
509   AStream.Position := 0;
510 end;
511 
512 procedure TChmContentProvider.QueueFillToc(AChm: TChmReader);
513 begin
514   fContentsTree.Visible := False;
515   fContentsPanel.Caption := slhelp_TableOfContentsLoadingPleaseWait;
516   fStatusBar.SimpleText := slhelp_TableOfContentsLoading;
517   Application.ProcessMessages;
518   Application.QueueAsyncCall(@FillToc, PtrInt(AChm));
519 end;
520 
521 procedure TChmContentProvider.FillTOC(Data: PtrInt);
522 var
523   CHMReader: TChmReader;
524   ParentNode: TTreeNode;
525   i: Integer;
526   SM: TChmSiteMap;
527   HasSearchIndex: Boolean = False;
528   {$IFNDEF CHM_BINARY_INDEX_TOC}
529   Stream: TMemoryStream;
530   {$ENDIF}
531 begin
532   if fFillingToc or fFillingIndex then
533   begin
534     Application.QueueAsyncCall(@FillToc, Data);
535     exit;
536   end;
537   fFillingToc := True;
538   fContentsTree.BeginUpdate;
539 
540   CHMReader := TChmReader(Data);
541   {$IFDEF CHM_DEBUG_TIME}
542   writeln('Start: ',FormatDateTime('hh:nn:ss.zzz', Now));
543   {$ENDIF}
544   if CHMReader <> nil then
545   begin
546     ParentNode := fContentsTree.Items.AddChildObject(nil, CHMReader.Title, CHMReader);
547     ParentNode.ImageIndex := 0;
548     ParentNode.SelectedIndex := 0;
549     {$IFDEF CHM_BINARY_INDEX_TOC}
550     // GetTOCSitemap first tries binary TOC but falls back to text if needed
551     SM := CHMReader.GetTOCSitemap;
552     {$ELSE}
553     SM := nil;
554     fFillingIndex := True;
555     Stream := TMemoryStream(fchm.GetObject(fChm.TOCFile));
556     if Stream <> nil then
557     begin
558       SM := TChmSiteMap.Create(stTOC);
559       SM.LoadFromStream(Stream);
560       Stream.Free;
561     end;
562     {$ENDIF}
563     if SM <> nil then
564     begin
565       {$IFDEF CHM_DEBUG_TIME}
566       writeln('Stream read: ',FormatDateTime('hh:nn:ss.zzz', Now));
567       {$ENDIF}
568       with TContentsFiller.Create(fContentsTree, SM, @fStopTimer, CHMReader) do
569       begin
570         DoFill(ParentNode);
571         Free;
572       end;
573       SM.Free;
574       if (fContentsTree.Selected = nil) and (fHistory.Count > 0) then
575         SelectTreeItemFromURL(fHistory.Strings[fHistoryIndex]);
576     end;
577     if ParentNode.Index = 0 then ParentNode.Expanded := True;
578     fFillingToc := False;
579     fContentsTree.EndUpdate;
580     fContentsTree.Visible := True;
581     fContentsPanel.Caption := '';
582     fContentsTab.TabVisible := fContentsTree.Items.Count > 1;
583     Application.ProcessMessages;
584     fFillingIndex := True;
585 
586     // we fill the index here too but only for the main file
587     if fChms.IndexOfObject(CHMReader) < 1 then
588     begin
589       {$IFDEF CHM_BINARY_INDEX_TOC}
590       SM := CHMReader.GetIndexSitemap;
591       {$ELSE}
592       SM := nil;
593       Stream := TMemoryStream(fchm.GetObject(fChm.IndexFile));
594       if Stream <> nil then
595       begin
596         SM := TChmSiteMap.Create(stTOC);
597         SM.LoadFromStream(Stream);
598         Stream.Free;
599       end;
600       {$ENDIF}
601       if SM <> nil then
602       begin
603         fStatusBar.SimpleText := slhelp_IndexLoading;
604         Application.ProcessMessages;
605         with TContentsFiller.Create(fIndexView, SM, @fStopTimer, CHMReader) do
606         begin
607           DoFill(nil);
608           Free;
609         end;
610         SM.Free;
611         fIndexView.FullExpand;
612       end;
613     end;
614   end;
615   fFillingIndex := False;
616   fIndexTab.TabVisible := fIndexView.Items.Count > 0;
617 
618   fStatusBar.SimpleText:= '';
619 
620   {$IFDEF CHM_DEBUG_TIME}
621   writeln('End: ',FormatDateTime('hh:nn:ss.zzz', Now));
622   {$ENDIF}
623 
624   {$IFDEF CHM_SEARCH}
625   i := 0;
626   while (HasSearchIndex = False) and (i < fChms.Count) do
627   begin
628     // Look for binary full text search index in CHM file
629     HasSearchIndex := fChms.Chm[i].ObjectExists('/$FIftiMain') > 0;
630     inc(i);
631   end;
632 
633   fSearchTab.TabVisible := HasSearchIndex;
634   {$ENDIF}
635 end;
636 
637 procedure TChmContentProvider.IpHtmlPanelDocumentOpen(Sender: TObject);
638 begin
639    // StatusBar1.Panels.Items[1] := fHtml.DataProvider.;
640  if fIsUsingHistory = False then
641    AddHistory(TIpChmDataProvider(fHtml.DataProvider).CurrentPage)
642  else fIsUsingHistory := False;
643  SelectTreeItemFromURL(TIpChmDataProvider(fHtml.DataProvider).CurrentPage);
644 end;
645 
646 procedure TChmContentProvider.IpHtmlPanelHotChange(Sender: TObject);
647 begin
648   fStatusBar.SimpleText := fHtml.HotURL;
649 end;
650 
651 procedure TChmContentProvider.IpHtmlPanelHotClick(Sender: TObject);
652 var
653   HelpFile: String;
654   aPos: integer;
655   lcURL: String;
656 begin
657   // chm-links look like: mk:@MSITStore:D:\LazPortable\docs\chm\iPro.chm::/html/lh3zs3.htm
658   lcURL := Lowercase(fHtml.HotURL);
659   if (Pos('javascript:helppopup(''', lcURL) = 1) or
660      (Pos('javascript:popuplink(''', lcURL) = 1)
661   then begin
662     HelpFile := Copy(fHtml.HotURL, 23, Length(fHtml.HotURL) - (23-1));
663     HelpFile := Copy(HelpFile, 1, Pos('''', HelpFile)-1);
664 
665     if (Pos('/',HelpFile)=0) and (Pos('.chm:',HelpFile)=0) then begin //looks like?: 'xyz.htm'
666       aPos := LastDelimiter('/', fHtml.CurURL);
667       if aPos>0 then HelpFile := Copy(fHtml.CurURL,1,aPos) + HelpFile;
668    end
669    else if (Pos('.chm:',HelpFile)=0) then begin //looks like?: 'folder/xyz.htm' or '/folder/xyz.htm'
670      if HelpFile[1]<>'/' then HelpFile:='/'+HelpFile;
671      aPos := LastDelimiter(':', fHtml.CurURL);
672      if aPos>0 then HelpFile := Copy(fHtml.CurURL,1,aPos) + HelpFile;
673    end;
674    DoLoadUri(HelpFile); //open it in current iphtmlpanel.
675  end
676  else
677    OpenURL(fHtml.HotURL);
678 end;
679 
680 procedure TChmContentProvider.PopupCopyClick(Sender: TObject);
681 begin
682   fHtml.CopyToClipboard;
683 end;
684 
685 procedure TChmContentProvider.PopupCopySourceClick(Sender: TObject);
686 var
687   rbs: rawbytestring;
688   s: String;
689 begin
690   rbs := TIpChmDataProvider(fHtml.DataProvider).GetHtmlText(fHtml.CurUrl);
691   s := ConvertEncoding(rbs, fHtml.MasterFrame.Html.DocCharset, encodingUTF8);
692   Clipboard.SetAsHtml(rbs, s);
693 end;
694 
695 procedure TChmContentProvider.ContentsTreeSelectionChanged(Sender: TObject);
696 var
697   ATreeNode: TContentTreeNode;
698   ARootNode: TTreeNode;
699   fChm: TChmReader = nil;
700   Uri: String;
701 begin
702   if (fContentsTree.Selected = nil) then Exit;
703   if fContentsTree.Selected.Parent = nil then
704   begin
705     fChm := TChmReader(fContentsTree.Selected.Data);
706     fActiveChmTitle:= fChm.Title;
707     UpdateTitle;
708     if fChm.DefaultPage <> '' then
709     begin
710       Uri := MakeURI(fChm.DefaultPage, fChm);
711       if ((fHtml.MasterFrame <> nil) and (MakeURI(fHtml.CurURL, fChm)  = Uri)) = False then
712         DoLoadUri(Uri);
713     end;
714     Exit;
715 
716   end;
717 
718   ATreeNode := TContentTreeNode(fContentsTree.Selected);
719 
720   //find the chm associated with this branch
721   ARootNode := ATreeNode.Parent;
722   while ARootNode.Parent <> nil do
723     ARootNode := ARootNode.Parent;
724 
725   fChm := TChmReader(ARootNode.Data);
726   try
727     fContentsTree.OnSelectionChanged := nil;
728     if ATreeNode.Url <> '' then
729     begin
730       Uri := MakeURI(ATreeNode.Url, fChm);
731       if ((fHtml.MasterFrame <> nil) and (MakeURI(fHtml.CurURL, fChm)  = Uri)) = False then
732         DoLoadUri(MakeURI(ATreeNode.Url, fChm));
733     end;
734   finally
735     fContentsTree.OnSelectionChanged := @ContentsTreeSelectionChanged;
736   end;
737 end;
738 
739 procedure TChmContentProvider.IndexViewDblClick(Sender: TObject);
740 var
741   ATreeNode: TContentTreeNode;
742 begin
743   if fIndexView.Selected = nil then Exit;
744   ATreeNode := TContentTreeNode(fIndexView.Selected);
745 
746   // Find the chm associated with this branch
747   DoLoadUri(MakeURI(ATreeNode.Url, TChmReader(ATreeNode.Data)));
748 end;
749 
750 procedure TChmContentProvider.TreeViewStopCollapse(Sender: TObject;
751   Node: TTreeNode; var AllowCollapse: Boolean);
752 begin
753   AllowCollapse:=False;
754 end;
755 
756 procedure TChmContentProvider.ViewMenuContentsClick(Sender: TObject);
757 begin
758   //TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
759   //fSplitter.Visible := TMenuItem(Sender).Checked;
760   //TabPanel.Visible := Splitter1.Visible;
761 end;
762 
763 procedure TChmContentProvider.UpdateTitle;
764 var
765   Item: TTreeNode;
766   NewTitle: String;
767 begin
768   Item := fContentsTree.Items.GetFirstNode;
769   NewTitle := '';
770   while Item <> nil do
771   begin
772     if Item.Text <> fActiveChmTitle then
773     begin
774       NewTitle:=NewTitle+Item.Text;
775       if (Item.GetNextSibling <> nil)
776       and ((Item.GetNextSibling.GetNextSibling <> nil) or (Item.GetNextSibling.Text <>  fActiveChmTitle))
777       then
778         NewTitle:=NewTitle+', ';
779     end;
780     Item := Item.GetNextSibling;
781   end;
782   if NewTitle <> '' then
783     NewTitle := FActiveChmTitle + ' [' + NewTitle + ']'
784   else
785     NewTitle := FActiveChmTitle;
786   if NewTitle = '' then NewTitle := DefaultCHMContentTitle;
787   Title := NewTitle;
788 end;
789 
790 procedure TChmContentProvider.SetTitle(const AValue: String);
791 begin
792   if fHtml.Parent = nil then exit;
793   TTabSheet(fHtml.Parent).Caption := AValue;
794   inherited SetTitle(AValue);
795 end;
796 
797 procedure TChmContentProvider.SearchEditChange(Sender: TObject);
798 var
799   ItemName: String;
800   SearchText: String;
801   Node: TTreeNode;
802 begin
803   if fIndexEdit <> Sender then
804     Exit;
805   SearchText := LowerCase(fIndexEdit.Text);
806   Node := fIndexView.Items.GetFirstNode;
807   while Node<>nil do
808   begin
809     ItemName := LowerCase(Copy(Node.Text, 1, Length(SearchText)));
810     if ItemName = SearchText then
811     begin
812       fIndexView.Items.GetLastNode.MakeVisible;
813       Node.MakeVisible;
814       Node.Selected:=True;
815       Exit;
816     end;
817     Node := Node.GetNextSibling;
818   end;
819   fIndexView.Selected:=nil;
820 end;
821 
822 procedure TChmContentProvider.TOCExpand(Sender: TObject; Node: TTreeNode);
823 begin
824   if Node.Parent <> nil then
825   begin
826     Node.ImageIndex := 2;
827     Node.SelectedIndex := 2;
828   end;
829 end;
830 
831 procedure TChmContentProvider.TOCCollapse(Sender: TObject; Node: TTreeNode) ;
832 begin
833   if Node.Parent <> nil then
834   begin
835     Node.ImageIndex := 1;
836     Node.SelectedIndex := 1;
837   end;
838 end;
839 
840 procedure TChmContentProvider.SelectTreeItemFromURL(AUrl: String);
841 var
842   FileName: String;
843   URL: String;
844   RootNode,
845   FoundNode,
846   Node: TTreeNode;
847   TmpHolder: TNotifyEvent;
848   i: integer;
849 begin
850   if fContentsTree.OnSelectionChanged = nil then
851     Exit; // the change was a response to a click and should be ignored
852   FileName := GetURIFileName(AUrl);
853   URL      := GetURIURL(AUrl);
854   FoundNode := nil;
855   Node := nil;
856   for i := 0 to fChms.Count-1 do
857   begin
858     if FileName = ExtractFileName(fChms.FileName[i]) then
859     begin
860       fActiveChmTitle:= fChms.Chm[i].Title;
861       UpdateTitle;
862 
863       RootNode := fContentsTree.Items.FindNodeWithData(fChms.Chm[i]);
864       if URL = fChms.Chm[i].DefaultPage then
865       begin
866         FoundNode := RootNode;
867         Break;
868       end;
869 
870       if RootNode <> nil then
871         Node := RootNode.GetFirstChild;
872 
873       Break;
874     end;
875 
876   end;
877 
878   if RootNode = nil then
879     Exit;
880 
881   TmpHolder := fContentsTree.OnSelectionChanged;
882   fContentsTree.OnSelectionChanged := nil;
883 
884   while (Node<>nil) and (TContentTreeNode(Node).Url<>Url) do
885     Node:=Node.GetNext;
886 
887   if (Node <> nil) and (TContentTreeNode(Node).Url = Url) then
888     FoundNode := Node;
889 
890   if FoundNode <> nil then
891   begin
892     fContentsTree.Selected := FoundNode;
893     if not FoundNode.IsVisible then
894       FoundNode.MakeVisible;
895   end
896   else
897     fContentsTree.Selected := nil;
898 
899   fContentsTree.OnSelectionChanged := TmpHolder;
900 end;
901 
902 {$IFDEF CHM_SEARCH}
903 
904 procedure TChmContentProvider.SearchComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
905 begin
906   case key of
907     VK_RETURN: SearchButtonClick(nil);
908 
909   end;
910 end;
911 
912 procedure TChmContentProvider.GetTreeNodeClass(Sender: TCustomTreeView;
913   var NodeClass: TTreeNodeClass);
914 begin
915   NodeClass := TContentTreeNode;
916 end;
917 
918 procedure TChmContentProvider.LoadPreferences(ACfg: TXMLConfig);
919 begin
920   inherited LoadPreferences(ACfg);
921   fTabsControl.Width := ACfg.GetValue(ClassName+'/TabControlWidth/Value', fTabsControl.Width);
922 end;
923 
924 procedure TChmContentProvider.SavePreferences(ACfg: TXMLConfig);
925 begin
926   inherited SavePreferences(ACfg);
927   ACfg.SetValue(ClassName+'/TabControlWidth/Value', fTabsControl.Width);
928 end;
929 
930 procedure TChmContentProvider.SearchButtonClick ( Sender: TObject ) ;
931 type
932   TTopicEntry = record
933     Topic:Integer;
934     Hits: Integer;
935     TitleHits: Integer;
936     FoundForThisRound: Boolean;
937   end;
938   TFoundTopics = array of TTopicEntry;
939 var
940   FoundTopics: TFoundTopics;
941 
942   procedure DeleteTopic(ATopicIndex: Integer);
943   var
944     MoveSize: DWord;
945   begin
946     //WriteLn('Deleting Topic');
947     if ATopicIndex < High(FoundTopics) then
948     begin
949       MoveSize := SizeOf(TTopicEntry) * (High(FoundTopics) - (ATopicIndex+1));
950       Move(FoundTopics[ATopicIndex+1], FoundTopics[ATopicIndex], MoveSize);
951     end;
952     SetLength(FoundTopics, Length(FoundTopics) -1);
953   end;
954 
955   function GetTopicIndex(ATopicID: Integer): Integer;
956   var
957     i: Integer;
958   begin
959     Result := -1;
960     for i := 0 to High(FoundTopics) do
961     begin
962       if FoundTopics[i].Topic = ATopicID then
963         Exit(i);
964     end;
965   end;
966 
967   procedure UpdateTopic(TopicID: Integer; NewHits: Integer; NewTitleHits: Integer; AddNewTopic: Boolean);
968   var
969     TopicIndex: Integer;
970   begin
971     //WriteLn('Updating topic');
972     TopicIndex := GetTopicIndex(TopicID);
973     if TopicIndex = -1 then
974     begin
975       if AddNewTopic = False then
976         Exit;
977       SetLength(FoundTopics, Length(FoundTopics)+1);
978       TopicIndex := High(FoundTopics);
979       FoundTopics[TopicIndex].Topic := TopicID;
980     end;
981 
982     FoundTopics[TopicIndex].FoundForThisRound := True;
983     if NewHits > 0 then
984       Inc(FoundTopics[TopicIndex].Hits, NewHits);
985     if NewTitleHits > 0 then
986       Inc(FoundTopics[TopicIndex].TitleHits, NewTitleHits);
987   end;
988 
989 var
990   TopicResults: TChmWLCTopicArray;
991   TitleResults: TChmWLCTopicArray;
992   FIftiMainStream: TMemoryStream;
993   SearchWords: TStringList;
994   SearchReader: TChmSearchReader;
995   DocTitle: String;
996   DocURL: String;
997   i: Integer;
998   j: Integer;
999   k: Integer;
1000   Item: TContentTreeNode;
1001 begin
1002   //  if fKeywordCombo.Text = '' then Exit;
1003   SearchWords := TStringList.Create;
1004   try
1005     SearchWords.Delimiter := ' ';
1006     Searchwords.DelimitedText := fKeywordCombo.Text;
1007     if fKeywordCombo.Items.IndexOf(fKeywordCombo.Text) = -1 then
1008       fKeywordCombo.Items.Add(fKeywordCombo.Text);
1009     fSearchResults.BeginUpdate;
1010     fSearchResults.Items.Clear;
1011     //WriteLn('Search words: ', SearchWords.Text);
1012     for i := 0 to fChms.Count-1 do
1013     begin
1014       for j := 0 to SearchWords.Count-1 do
1015       begin
1016         if fChms.Chm[i].SearchReader = nil then
1017         begin
1018           FIftiMainStream := fchms.Chm[i].GetObject('/$FIftiMain');
1019           if FIftiMainStream = nil then
1020             continue;
1021           SearchReader := TChmSearchReader.Create(FIftiMainStream, True); //frees the stream when done
1022           fChms.Chm[i].SearchReader := SearchReader;
1023         end
1024         else
1025           SearchReader := fChms.Chm[i].SearchReader;
1026         TopicResults := SearchReader.LookupWord(SearchWords[j], TitleResults);
1027         // Body results
1028         for k := 0 to High(TopicResults) do
1029           UpdateTopic(TopicResults[k].TopicIndex, High(TopicResults[k].LocationCodes), 0, j = 0);
1030         // Title results
1031         for k := 0 to High(TitleResults) do
1032           UpdateTopic(TitleResults[k].TopicIndex, 0, High(TitleResults[k].LocationCodes), j = 0);
1033 
1034         // Remove documents that don't have results
1035         k := 0;
1036         while k <= High(FoundTopics) do
1037         begin
1038           if FoundTopics[k].FoundForThisRound = False then
1039             DeleteTopic(k)
1040           else
1041           begin
1042             FoundTopics[k].FoundForThisRound := False;
1043             Inc(k);
1044           end;
1045         end;
1046       end;
1047 
1048       // Clear out results that don't contain all the words we are looking for
1049 
1050       Item := nil;
1051       // Now lookup titles and urls to add to final search results
1052       for j := 0 to High(FoundTopics) do
1053       begin
1054         try
1055           DocURL := fChms.Chm[i].LookupTopicByID(FoundTopics[j].Topic, DocTitle);
1056           if (Length(DocURL) > 0) and (DocURL[1] <> '/') then
1057             Insert('/', DocURL, 1);
1058           if DocTitle = '' then
1059             DocTitle := slhelp_Untitled;
1060           Item := TContentTreeNode(fSearchResults.Items.Add(Item, DocTitle));
1061           Item.Data:= fChms.Chm[i];
1062           Item.Url:= DocURL;
1063         except
1064           //WriteLn('Exception');
1065           // :)
1066         end;
1067       end;
1068 
1069       SetLength(FoundTopics, 0);
1070     end;
1071     SetLength(FoundTopics, 0);
1072   finally
1073     SearchWords.Free;
1074   end;
1075 
1076   if fSearchResults.Items.Count = 0 then
1077   begin
1078     fSearchResults.Items.Add(nil, slhelp_NoResults);
1079   end;
1080   fSearchResults.EndUpdate;
1081 end;
1082 
1083 procedure TChmContentProvider.SearchResultsDblClick ( Sender: TObject ) ;
1084 var
1085   Item: TContentTreeNode;
1086 begin
1087   Item := TContentTreeNode(fSearchResults.Selected);
1088   if (Item = nil) or (Item.Data = nil) then
1089     Exit;
1090   FLoadingSearchURL:= True;
1091   DoLoadUri(MakeURI(Item.Url, TChmReader(Item.Data)));
1092   FLoadingSearchURL:= False;
1093 end;
1094 {$ENDIF}
1095 
1096 
CanGoBacknull1097 function TChmContentProvider.CanGoBack: Boolean;
1098 begin
1099   Result := fHistoryIndex > 0;
1100 end;
1101 
CanGoForwardnull1102 function TChmContentProvider.CanGoForward: Boolean;
1103 begin
1104   Result := fHistoryIndex < fHistory.Count-1
1105 end;
1106 
GetHistorynull1107 function TChmContentProvider.GetHistory: TStrings;
1108 begin
1109   Result:= fHistory;
1110 end;
1111 
LoadURLnull1112 function TChmContentProvider.LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean;
1113 var
1114   fFile: String;
1115   fURL: String = '';
1116   fPos: Integer;
1117   FileIndex: Integer;
1118   LoadTOC: Boolean;
1119   CurCHM: TChmReader;
1120   ContextURL: String;
1121 begin
1122   Result := False;
1123   fFile := Copy(AUrl,8, Length(AURL));
1124   fPos := Pos('://', fFile);
1125   if fPos > 0 then
1126   begin
1127     fURL := Copy(fFile, fPos+3, Length(fFIle));
1128     fFile := Copy(fFIle, 1, fPos-1);
1129   end;
1130 
1131   LoadTOC := (fChms = nil) or (fChms.IndexOf(fFile) < 0);
1132   DoOpenChm(fFile, False);
1133 
1134   // in case of exception fChms can be still = nil
1135   if fChms <> nil then
1136     FileIndex := fChms.IndexOf(fFile)
1137   else
1138     Exit;
1139 
1140   CurCHM := fChms.Chm[FileIndex];
1141 
1142   if LoadTOC and (FileIndex = 0) then
1143   begin
1144     QueueFillToc(CurCHM);
1145   end;
1146 
1147   // AContext will override the URL if it is found
1148   if AContext <> -1 then
1149   begin
1150     ContextURL := CurCHM.GetContextUrl(AContext);
1151     if (Length(ContextURL) > 0) and not (ContextURL[1] in ['/', '\']) then
1152       Insert('/', ContextURL , 1);
1153     if Length(ContextURL) > 0 then
1154       fURL := ContextURL;
1155   end;
1156 
1157   if fURL <> '' then
1158     DoLoadUri(MakeURI(fURL, CurCHM))
1159   else
1160     DoLoadUri(MakeURI(CurCHM.DefaultPage, CurCHM));
1161   Result := True;
1162 
1163   fChms.OnOpenNewFile := @NewChmOpened;
1164 end;
1165 
1166 procedure TChmContentProvider.GoHome;
1167 begin
1168   if (fChms <> nil) and (fChms.Chm[0].DefaultPage <> '') then
1169   begin
1170     DoLoadUri(MakeURI(fChms.Chm[0].DefaultPage, fChms.Chm[0]));
1171   end;
1172 end;
1173 
1174 procedure TChmContentProvider.GoBack;
1175 begin
1176   if CanGoBack then
1177   begin
1178     Dec(fHistoryIndex);
1179     fIsUsingHistory:=True;
1180     fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
1181   end;
1182 end;
1183 
1184 procedure TChmContentProvider.GoForward;
1185 var
1186   HistoryChm: TChmReader;
1187 begin
1188   if CanGoForward then
1189   begin
1190     Inc(fHistoryIndex);
1191     fIsUsingHistory:=True;
1192     HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
1193     fChms.ObjectExists(fHistory.Strings[fHistoryIndex], HistoryChm); // this ensures that the correct chm will be found
1194     fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
1195   end;
1196 end;
1197 
1198 class function TChmContentProvider.GetProperContentProvider(const AURL: String
1199   ): TBaseContentProviderClass;
1200 begin
1201   Result:=TChmContentProvider;
1202 end;
1203 
1204 constructor TChmContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
1205 const
1206   TAB_WIDTH = 215;
1207 begin
1208   inherited Create(AParent, AImageList);
1209 
1210   fHistory := TStringList.Create;
1211 
1212   fTabsControl := TPageControl.Create(AParent);
1213   with fTabsControl do
1214   begin
1215     Width := TAB_WIDTH + 12;
1216     Align := alLeft;
1217     Parent := AParent;
1218     Visible := True;
1219   end;
1220 
1221   fContentsTab := TTabSheet.Create(fTabsControl);
1222   with fContentsTab do
1223   begin
1224     Caption := slhelp_Contents;
1225     Parent := fTabsControl;
1226     //BorderSpacing.Around := 6;
1227   end;
1228   fContentsPanel := TPanel.Create(fContentsTab);
1229   with fContentsPanel do
1230   begin
1231     Parent := fContentsTab;
1232     Align := alClient;
1233     BevelOuter := bvNone;
1234     Caption := '';
1235     Visible := True;
1236   end;
1237   fContentsTree := TTreeView.Create(fContentsPanel);
1238   with fContentsTree do
1239   begin
1240     Parent := fContentsPanel;
1241     Align := alClient;
1242     BorderSpacing.Around := 6;
1243     ReadOnly := True;
1244     Visible := True;
1245     OnSelectionChanged := @ContentsTreeSelectionChanged;
1246     OnExpanded := @TOCExpand;
1247     OnCollapsed := @TOCCollapse;
1248     OnCreateNodeClass:=@GetTreeNodeClass;
1249     Images := fImageList;
1250     //StateImages := fImageList;
1251   end;
1252 
1253   fIndexTab := TTabSheet.Create(fTabsControl);
1254   with fIndexTab do
1255   begin
1256     Caption := slhelp_Index;
1257     Parent := fTabsControl;
1258     //BorderSpacing.Around := 6;
1259   end;
1260 
1261   fIndexEdit := TLabeledEdit.Create(fIndexTab);
1262   with fIndexEdit do
1263   begin
1264     Parent := fIndexTab;
1265     Anchors := [akLeft, akRight, akTop];
1266     BorderSpacing.Around := 6;
1267     AnchorSide[akLeft].Control := fIndexTab;
1268     AnchorSide[akRight].Control := fIndexTab;
1269     AnchorSide[akRight].Side := asrBottom;
1270     AnchorSide[akTop].Control := fIndexTab;
1271     EditLabel.Caption := slhelp_Search;
1272     EditLabel.AutoSize := True;
1273     LabelPosition := lpAbove;
1274     OnChange := @SearchEditChange;
1275     Visible := True;
1276   end;
1277 
1278   fIndexView := TTreeView.Create(fIndexTab);
1279   with fIndexView do
1280   begin
1281     Anchors := [akLeft, akTop, akRight, akBottom];
1282     BorderSpacing.Around := 6;
1283     AnchorSide[akLeft].Control := fIndexTab;
1284     AnchorSide[akRight].Control := fIndexTab;
1285     AnchorSide[akRight].Side := asrBottom;
1286     AnchorSide[akTop].Control := fIndexEdit;
1287     AnchorSide[akTop].Side := asrBottom;
1288     AnchorSide[akBottom].Control := fIndexTab;
1289     AnchorSide[akBottom].Side := asrBottom;
1290     Parent := fIndexTab;
1291     BorderSpacing.Around := 6;
1292     ReadOnly := True;
1293     Visible := True;
1294     ShowButtons:=False;
1295     ShowLines:=False;
1296     ShowRoot:=False;
1297     OnCollapsing:=@TreeViewStopCollapse;
1298     OnDblClick := @IndexViewDblClick;
1299     OnCreateNodeClass:=@GetTreeNodeClass;
1300   end;
1301 
1302 
1303  // {$IFDEF CHM_SEARCH}
1304   fSearchTab := TTabSheet.Create(fTabsControl);
1305   with fSearchTab do
1306   begin
1307     Caption := slhelp_Search;
1308     Parent := fTabsControl;
1309   end;
1310   fKeywordLabel := TLabel.Create(fSearchTab);
1311   with fKeywordLabel do
1312   begin
1313     Parent := fSearchTab;
1314     Top := 6;
1315     Caption := slhelp_Keyword;
1316     Left := 6;
1317     AutoSize := True;
1318   end;
1319   fKeywordCombo := TComboBox.Create(fSearchTab);
1320   with fKeywordCombo do
1321   begin
1322     Parent := fSearchTab;
1323     Anchors := [akLeft, akRight, akTop];
1324     BorderSpacing.Around := 6;
1325     AnchorSide[akLeft].Control := fSearchTab;
1326     AnchorSide[akRight].Control := fSearchTab;
1327     AnchorSide[akRight].Side := asrBottom;
1328     AnchorSide[akTop].Control := fKeywordLabel;
1329     AnchorSide[akTop].Side := asrBottom;
1330     OnKeyDown  := @SearchComboKeyDown;
1331   end;
1332 
1333   fSearchBtn := TButton.Create(fSearchTab);
1334   with fSearchBtn do
1335   begin
1336     Parent := fSearchTab;
1337     Anchors := [akLeft, akTop];
1338     BorderSpacing.Around := 6;
1339     AnchorSide[akLeft].Control := fSearchTab;
1340     AnchorSide[akTop].Control := fKeywordCombo;
1341     AnchorSide[akTop].Side := asrBottom;
1342     Caption := slhelp_Find;
1343     OnClick := @SearchButtonClick;
1344   end;
1345   fResultsLabel := TLabel.Create(fSearchTab);
1346   with fResultsLabel do
1347   begin
1348     Parent := fSearchTab;
1349     Anchors := [akLeft, akTop];
1350     BorderSpacing.Around := 6;
1351     AnchorSide[akLeft].Control := fSearchTab;
1352     AnchorSide[akRight].Control := fSearchTab;
1353     AnchorSide[akRight].Side := asrBottom;
1354     AnchorSide[akTop].Control := fSearchBtn;
1355     AnchorSide[akTop].Side := asrBottom;
1356     Caption := slhelp_SearchResults;
1357     AutoSize := True;
1358   end;
1359   fSearchResults := TTreeView.Create(fSearchTab);
1360   with fSearchResults do
1361   begin
1362     Parent := fSearchTab;
1363     Anchors := [akLeft, akTop, akRight, akBottom];
1364     BorderSpacing.Around := 6;
1365     AnchorSide[akLeft].Control := fSearchTab;
1366     AnchorSide[akRight].Control := fSearchTab;
1367     AnchorSide[akRight].Side := asrBottom;
1368     AnchorSide[akTop].Control := fResultsLabel;
1369     AnchorSide[akTop].Side := asrBottom;
1370     AnchorSide[akBottom].Control := fSearchTab;
1371     AnchorSide[akBottom].Side := asrBottom;
1372     ReadOnly := True;
1373     ShowButtons := False;
1374     ShowLines := False;
1375     ShowRoot:=False;
1376     OnDblClick := @SearchResultsDblClick;
1377     OnCollapsing:=@TreeViewStopCollapse;
1378     OnCreateNodeClass:=@GetTreeNodeClass;
1379   end;
1380  // {$ENDIF}
1381 
1382 
1383   fHtml := TIpHtmlPanel.Create(Parent);
1384   with fHtml do
1385   begin
1386     DataProvider := TIpChmDataProvider.Create(fHtml, fChms);
1387     TIpChmDataProvider(DataProvider).OnGetHtmlPage:=@LoadingHTMLStream;
1388     OnDocumentOpen := @IpHtmlPanelDocumentOpen;
1389     OnHotChange := @IpHtmlPanelHotChange;
1390     OnHotClick := @IpHtmlPanelHotClick;
1391     Parent := AParent;
1392     Align := alClient;
1393   end;
1394 
1395   fSplitter := TSplitter.Create(Parent);
1396   with fSplitter do
1397   begin
1398     //Align  := alLeft;
1399     Left := 1;
1400     AnchorSide[akLeft].Control := fTabsControl;
1401     AnchorSide[akLeft].Side:= asrRight;
1402     AnchorSide[akRight].Control := fHtml;
1403     AnchorSide[akRight].Side := asrLeft;
1404     Parent := AParent;
1405   end;
1406 
1407 
1408   fPopUp := TPopupMenu.Create(fHtml);
1409   fPopUp.Items.Add(TMenuItem.Create(fPopup));
1410   with fPopUp.Items.Items[0] do
1411   begin
1412     Caption := slhelp_Copy;
1413     OnClick := @PopupCopyClick;
1414   end;
1415   fPopup.Items.Add(TMenuItem.Create(fPopup));
1416   with fPopup.Items.Items[1] do
1417   begin
1418     Caption := 'Copy source';
1419     OnClick := @PopupCopySourceClick;
1420   end;
1421   fHtml.PopupMenu := fPopUp;
1422 
1423   fStatusBar := TStatusBar.Create(AParent);
1424   with fStatusBar do
1425   begin
1426     Parent := AParent;
1427     Align := alBottom;
1428     SimplePanel := True;
1429   end;
1430 end;
1431 
1432 destructor TChmContentProvider.Destroy;
1433 begin
1434   DoCloseChm;
1435   fHistory.Free;
1436   inherited Destroy;
1437 end;
1438 
1439 initialization
1440 
1441   RegisterFileType('.chm', TChmContentProvider);
1442 
1443 end.
1444 
1445