mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 17:23:43 +02:00
842 lines
22 KiB
ObjectPascal
842 lines
22 KiB
ObjectPascal
unit chmcontentprovider;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{off $DEFINE CHM_DEBUG_TIME}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
FileUtil, Forms, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus,
|
|
BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider;
|
|
|
|
type
|
|
|
|
{ TChmContentProvider }
|
|
|
|
TChmContentProvider = class(TFileContentProvider)
|
|
private
|
|
fTabsControl: TPageControl;
|
|
fContentsTab: TTabSheet;
|
|
fContentsPanel: TPanel;
|
|
fContentsTree: TTreeView;
|
|
fIndexTab: TTabSheet;
|
|
fIndexEdit: TLabeledEdit;
|
|
fIndexView: TListView;
|
|
fSearchTab: TTabSheet;
|
|
fKeywordLabel: TLabel;
|
|
fKeywordCombo: TComboBox;
|
|
fSearchBtn: TButton;
|
|
fResultsLabel: TLabel;
|
|
fSearchResults: TListView;
|
|
fSplitter: TSplitter;
|
|
fHtml: TIpHtmlPanel;
|
|
fPopUp: TPopUpMenu;
|
|
fStatusBar: TStatusBar;
|
|
fContext: THelpContext;
|
|
protected
|
|
fIsUsingHistory: Boolean;
|
|
fChms: TChmFileList;
|
|
fHistory: TStringList;
|
|
fHistoryIndex: Integer;
|
|
fStopTimer: Boolean;
|
|
fFillingToc: Boolean;
|
|
|
|
function MakeURI(AUrl: String; AChm: TChmReader): String;
|
|
|
|
procedure AddHistory(URL: String);
|
|
procedure DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
|
|
procedure DoCloseChm;
|
|
procedure DoLoadContext(Context: THelpContext);
|
|
procedure DoLoadUri(Uri: String; AChm: TChmReader = nil);
|
|
procedure DoError(Error: Integer);
|
|
procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer);
|
|
|
|
procedure FillTOC(Data: PtrInt);
|
|
procedure IpHtmlPanelDocumentOpen(Sender: TObject);
|
|
procedure IpHtmlPanelHotChange(Sender: TObject);
|
|
procedure PopupCopyClick(Sender: TObject);
|
|
procedure ContentsTreeSelectionChanged(Sender: TObject);
|
|
procedure IndexViewDblClick(Sender: TObject);
|
|
procedure ViewMenuContentsClick(Sender: TObject);
|
|
procedure SetTitle(const ATitle: String);
|
|
procedure SearchEditChange(Sender: TObject);
|
|
procedure SearchButtonClick(Sender: TObject);
|
|
procedure SearchResultsDblClick(Sender: TObject);
|
|
public
|
|
function CanGoBack: Boolean; override;
|
|
function CanGoForward: Boolean; override;
|
|
function GetHistory: TStrings; override;
|
|
function LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; override;
|
|
procedure GoHome; override;
|
|
procedure GoBack; override;
|
|
procedure GoForward; override;
|
|
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override;
|
|
|
|
constructor Create(AParent: TWinControl); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses ChmSpecialParser, chmFIftiMain;
|
|
|
|
function GetURIFileName(AURI: String): String;
|
|
var
|
|
FileStart,
|
|
FileEnd: Integer;
|
|
begin
|
|
FileStart := Pos(':', AURI)+1;
|
|
FileEnd := Pos('::', AURI);
|
|
|
|
Result := Copy(AURI, FileStart, FileEnd-FileStart);
|
|
end;
|
|
|
|
function GetURIURL(AURI: String): String;
|
|
var
|
|
URLStart: Integer;
|
|
begin
|
|
URLStart := Pos('::', AURI) + 2;
|
|
Result := Copy(AURI, URLStart, Length(AURI));
|
|
end;
|
|
|
|
function ChmURI(AUrl: String; AFileName: String): String;
|
|
var
|
|
FileNameNoPath: String;
|
|
begin
|
|
Result := AUrl;
|
|
if Pos('ms-its:', Result) > 0 then
|
|
Exit;
|
|
FileNameNoPath := ExtractFileName(AFileName);
|
|
|
|
Result := 'ms-its:'+FileNameNoPath+'::'+AUrl;
|
|
end;
|
|
|
|
{ TChmContentProvider }
|
|
|
|
function TChmContentProvider.MakeURI ( AUrl: String; AChm: TChmReader ) : String;
|
|
var
|
|
ChmIndex: Integer;
|
|
begin
|
|
ChmIndex := fChms.IndexOfObject(AChm);
|
|
|
|
Result := ChmURI(AUrl, fChms.FileName[ChmIndex]);
|
|
end;
|
|
|
|
procedure TChmContentProvider.AddHistory(URL: String);
|
|
begin
|
|
if fHistoryIndex < fHistory.Count then begin
|
|
while fHistory.Count-1 > fHistoryIndex do
|
|
fHistory.Delete(fHistory.Count-1);
|
|
end;
|
|
|
|
fHistory.Add(URL);
|
|
Inc(fHistoryIndex);
|
|
end;
|
|
|
|
type
|
|
TCHMHack = class(TChmFileList)
|
|
end;
|
|
|
|
procedure TChmContentProvider.DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
|
|
begin
|
|
if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit;
|
|
if ACloseCurrent then DoCloseChm;
|
|
if not FileExistsUTF8(AFile) or DirectoryExistsUTF8(AFile) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
if fChms = nil 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);
|
|
//DoError(INVALID_FILE_TYPE);
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
TCHMHack(fChms).OpenNewFile(AFile);
|
|
WriteLn('Loading new chm: ', AFile);
|
|
end;
|
|
|
|
if fChms = nil then Exit;
|
|
|
|
fHistoryIndex := -1;
|
|
fHistory.Clear;
|
|
|
|
// Code Here has been moved to the OpenFile handler
|
|
|
|
//FileMenuCloseItem.Enabled := True;
|
|
if fChms.Chm[0].Title <> '' then SetTitle(fChms.Chm[0].Title);
|
|
end;
|
|
|
|
procedure TChmContentProvider.DoCloseChm;
|
|
var
|
|
i : integer;
|
|
begin
|
|
fStopTimer := True;
|
|
if assigned(fChms) then
|
|
begin
|
|
for i := 0 to fChms.Count -1 do
|
|
fChms.Chm[i].Free;
|
|
end;
|
|
FreeAndNil(fChms);
|
|
end;
|
|
|
|
procedure TChmContentProvider.DoLoadContext(Context: THelpContext);
|
|
var
|
|
Str: String;
|
|
begin
|
|
if fChms = nil then exit;
|
|
Str := fChms.Chm[0].GetContextUrl(Context);
|
|
if Str <> '' then DoLoadUri(Str, fChms.Chm[0]);
|
|
end;
|
|
|
|
procedure TChmContentProvider.DoLoadUri(Uri: String; AChm: TChmReader = nil);
|
|
var
|
|
ChmIndex: Integer;
|
|
NewUrl: String;
|
|
begin
|
|
if (fChms = nil) and (AChm = nil) then exit;
|
|
if fChms.ObjectExists(Uri, AChm) = 0 then begin
|
|
fStatusBar.SimpleText := URI + ' not found!';
|
|
Exit;
|
|
end;
|
|
if (Pos('ms-its', Uri) = 0) and (AChm <> nil) then
|
|
begin
|
|
ChmIndex := fChms.IndexOfObject(AChm);
|
|
NewUrl := ExtractFileName(fChms.FileName[ChmIndex]);
|
|
NewUrl := 'ms-its:'+NewUrl+'::/'+Uri;
|
|
Uri := NewUrl;
|
|
end;
|
|
|
|
fIsUsingHistory := True;
|
|
fHtml.OpenURL(Uri);
|
|
TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URI)+'/';
|
|
AddHistory(Uri);
|
|
end;
|
|
|
|
|
|
procedure TChmContentProvider.DoError(Error: Integer);
|
|
begin
|
|
//what to do with these errors?
|
|
//INVALID_FILE_TYPE;
|
|
end;
|
|
|
|
procedure TChmContentProvider.NewChmOpened(ChmFileList: TChmFileList;
|
|
Index: Integer);
|
|
begin
|
|
if Index = 0 then begin
|
|
fContentsTree.Items.Clear;
|
|
if fContext > -1 then begin
|
|
DoLoadContext(fContext);
|
|
fContext := -1;
|
|
end
|
|
else if ChmFileList.Chm[Index].DefaultPage <> '' then begin
|
|
DoLoadUri(MakeURI(ChmFileList.Chm[Index].DefaultPage, ChmFileList.Chm[Index]));
|
|
end;
|
|
end;
|
|
if ChmFileList.Chm[Index].Title = '' then
|
|
ChmFileList.Chm[Index].Title := ExtractFileName(ChmFileList.FileName[Index]);
|
|
|
|
// Fill the table of contents.
|
|
if Index <> 0 then
|
|
Application.QueueAsyncCall(@FillToc, PtrInt(ChmFileList.Chm[Index]));
|
|
end;
|
|
|
|
procedure TChmContentProvider.FillTOC(Data: PtrInt);
|
|
var
|
|
Stream: TMemoryStream;
|
|
fChm: TChmReader;
|
|
ParentNode: TTreeNode;
|
|
begin
|
|
if fFillingToc = True then begin
|
|
Application.QueueAsyncCall(@FillToc, Data);
|
|
exit;
|
|
end;
|
|
fFillingToc := True;
|
|
fContentsTree.Visible := False;
|
|
Application.ProcessMessages;
|
|
fChm := TChmReader(Data);
|
|
{$IFDEF CHM_DEBUG_TIME}
|
|
writeln('Start: ',FormatDateTime('hh:nn:ss.zzz', Now));
|
|
{$ENDIF}
|
|
if fChm <> nil then begin
|
|
ParentNode := fContentsTree.Items.AddChildObject(nil, fChm.Title, fChm);
|
|
Stream := TMemoryStream(fchm.GetObject(fChm.TOCFile));
|
|
if Stream <> nil then begin
|
|
Stream.position := 0;
|
|
{$IFDEF CHM_DEBUG_TIME}
|
|
writeln('Stream read: ',FormatDateTime('hh:nn:ss.zzz', Now));
|
|
{$ENDIF}
|
|
with TContentsFiller.Create(fContentsTree, Stream, @fStopTimer) do begin
|
|
DoFill(ParentNode);
|
|
Free;
|
|
end;
|
|
end;
|
|
Stream.Free;
|
|
// we fill the index here too but only for the main file
|
|
if fChms.IndexOfObject(fChm) < 1 then
|
|
begin
|
|
Stream := fchms.GetObject(fChm.IndexFile);
|
|
if Stream <> nil then begin
|
|
Stream.position := 0;
|
|
with TIndexFiller.Create(fIndexView, Stream) do begin;
|
|
DoFill;
|
|
Free;
|
|
end;
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
if ParentNode.Index = 0 then ParentNode.Expanded := True;
|
|
|
|
|
|
|
|
fContentsTree.Visible := True;
|
|
{$IFDEF CHM_DEBUG_TIME}
|
|
writeln('Eind: ',FormatDateTime('hh:nn:ss.zzz', Now));
|
|
{$ENDIF}
|
|
fFillingToc := False;
|
|
end;
|
|
|
|
procedure TChmContentProvider.IpHtmlPanelDocumentOpen(Sender: TObject);
|
|
var
|
|
AChm: TChmReader;
|
|
begin
|
|
// StatusBar1.Panels.Items[1] := fHtml.DataProvider.;
|
|
if fIsUsingHistory = False then
|
|
AddHistory(TIpChmDataProvider(fHtml.DataProvider).CurrentPage)
|
|
else fIsUsingHistory := False;
|
|
end;
|
|
|
|
procedure TChmContentProvider.IpHtmlPanelHotChange(Sender: TObject);
|
|
begin
|
|
fStatusBar.SimpleText := fHtml.HotURL;
|
|
end;
|
|
|
|
procedure TChmContentProvider.PopupCopyClick(Sender: TObject);
|
|
begin
|
|
fHtml.CopyToClipboard;
|
|
end;
|
|
|
|
procedure TChmContentProvider.ContentsTreeSelectionChanged(Sender: TObject);
|
|
var
|
|
ATreeNode: TContentTreeNode;
|
|
ARootNode: TTreeNode;
|
|
fChm: TChmReader = nil;
|
|
begin
|
|
if (fContentsTree.Selected = nil) then Exit;
|
|
if not(fContentsTree.Selected is TContentTreeNode) then
|
|
begin
|
|
fChm := TChmReader(fContentsTree.Selected.Data);
|
|
if fChm.DefaultPage <> '' then
|
|
DoLoadUri(MakeURI(fChm.DefaultPage, fChm));
|
|
Exit;
|
|
end;
|
|
ATreeNode := TContentTreeNode(fContentsTree.Selected);
|
|
|
|
//find the chm associated with this branch
|
|
ARootNode := ATreeNode.Parent;
|
|
while ARootNode.Parent <> nil do
|
|
ARootNode := ARootNode.Parent;
|
|
|
|
fChm := TChmReader(ARootNode.Data);
|
|
if ATreeNode.Url <> '' then begin
|
|
DoLoadUri(MakeURI(ATreeNode.Url, fChm));
|
|
end;
|
|
end;
|
|
|
|
procedure TChmContentProvider.IndexViewDblClick(Sender: TObject);
|
|
var
|
|
SelectedItem: TListItem;
|
|
RealItem: TIndexItem;
|
|
begin
|
|
SelectedItem := fIndexView.Selected;
|
|
if SelectedItem = nil then Exit;
|
|
|
|
RealItem := TIndexItem(SelectedItem);
|
|
if not fIndexEdit.Focused then
|
|
fIndexEdit.Text := Trim(RealItem.Caption);
|
|
if RealItem.Url <> '' then begin
|
|
DoLoadUri(MakeURI(RealItem.Url, TChmReader(RealItem.Data)));
|
|
end;
|
|
end;
|
|
|
|
procedure TChmContentProvider.ViewMenuContentsClick(Sender: TObject);
|
|
begin
|
|
//TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
|
|
//fSplitter.Visible := TMenuItem(Sender).Checked;
|
|
//TabPanel.Visible := Splitter1.Visible;
|
|
end;
|
|
|
|
procedure TChmContentProvider.SetTitle(const ATitle: String);
|
|
begin
|
|
if fHtml.Parent = nil then exit;
|
|
TTabSheet(fHtml.Parent).Caption := ATitle;
|
|
end;
|
|
|
|
procedure TChmContentProvider.SearchEditChange(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
ItemName: String;
|
|
SearchText: String;
|
|
begin
|
|
if fIndexEdit.Text = '' then Exit;
|
|
if not fIndexEdit.Focused then Exit;
|
|
SearchText := LowerCase(fIndexEdit.Text);
|
|
for I := 0 to fIndexView.Items.Count-1 do begin
|
|
ItemName := LowerCase(Copy(fIndexView.Items.Item[I].Caption, 1, Length(SearchText)));
|
|
if ItemName = SearchText then begin
|
|
fIndexView.Items.Item[fIndexView.Items.Count-1].MakeVisible(False);
|
|
fIndexView.Items.Item[I].MakeVisible(False);
|
|
fIndexView.Items.Item[I].Selected := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TChmContentProvider.SearchButtonClick ( Sender: TObject ) ;
|
|
type
|
|
TTopicEntry = record
|
|
Topic:Integer;
|
|
Hits: Integer;
|
|
TitleHits: Integer;
|
|
FoundForThisRound: Boolean;
|
|
end;
|
|
TFoundTopics = array of TTopicEntry;
|
|
var
|
|
FoundTopics: TFoundTopics;
|
|
|
|
procedure DeleteTopic(ATopicIndex: Integer);
|
|
var
|
|
MoveSize: DWord;
|
|
begin
|
|
//WriteLn('Deleting Topic');
|
|
if ATopicIndex < High(FoundTopics) then
|
|
begin
|
|
MoveSize := SizeOf(TTopicEntry) * (High(FoundTopics) - (ATopicIndex+1));
|
|
Move(FoundTopics[ATopicIndex+1], FoundTopics[ATopicIndex], MoveSize);
|
|
end;
|
|
SetLength(FoundTopics, Length(FoundTopics) -1);
|
|
end;
|
|
|
|
function GetTopicIndex(ATopicID: Integer): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to High(FoundTopics) do begin
|
|
if FoundTopics[i].Topic = ATopicID then
|
|
Exit(i);
|
|
end;
|
|
end;
|
|
|
|
procedure UpdateTopic(TopicID: Integer; NewHits: Integer; NewTitleHits: Integer; AddNewTopic: Boolean);
|
|
var
|
|
TopicIndex: Integer;
|
|
begin
|
|
//WriteLn('Updating topic');
|
|
TopicIndex := GetTopicIndex(TopicID);
|
|
if TopicIndex = -1 then
|
|
begin
|
|
if AddNewTopic = False then
|
|
Exit;
|
|
SetLength(FoundTopics, Length(FoundTopics)+1);
|
|
TopicIndex := High(FoundTopics);
|
|
FoundTopics[TopicIndex].Topic := TopicID;
|
|
end;
|
|
|
|
FoundTopics[TopicIndex].FoundForThisRound := True;
|
|
if NewHits > 0 then
|
|
Inc(FoundTopics[TopicIndex].Hits, NewHits);
|
|
if NewTitleHits > 0 then
|
|
Inc(FoundTopics[TopicIndex].TitleHits, NewTitleHits);
|
|
end;
|
|
|
|
var
|
|
TopicResults: TChmWLCTopicArray;
|
|
TitleResults: TChmWLCTopicArray;
|
|
FIftiMainStream: TMemoryStream;
|
|
SearchWords: TStringList;
|
|
SearchReader: TChmSearchReader;
|
|
DocTitle: String;
|
|
DocURL: String;
|
|
TitleIndex: Integer = -1;
|
|
i: Integer;
|
|
j: Integer;
|
|
k: Integer;
|
|
ListItem: TListItem;
|
|
begin
|
|
SearchWords := TStringList.Create;
|
|
SearchWords.Delimiter := ' ';
|
|
Searchwords.DelimitedText := fKeywordCombo.Text;
|
|
fSearchResults.BeginUpdate;
|
|
fSearchResults.Clear;
|
|
//WriteLn('Search words: ', SearchWords.Text);
|
|
for i := 0 to fChms.Count-1 do
|
|
begin
|
|
for j := 0 to SearchWords.Count-1 do
|
|
begin
|
|
if fChms.Chm[i].SearchReader = nil then
|
|
begin
|
|
FIftiMainStream := fchms.Chm[i].GetObject('/$FIftiMain');
|
|
if FIftiMainStream = nil then
|
|
continue;
|
|
SearchReader := TChmSearchReader.Create(FIftiMainStream, True); //frees the stream when done
|
|
fChms.Chm[i].SearchReader := SearchReader;
|
|
end
|
|
else
|
|
SearchReader := fChms.Chm[i].SearchReader;
|
|
TopicResults := SearchReader.LookupWord(SearchWords[j], TitleResults);
|
|
// body results
|
|
for k := 0 to High(TopicResults) do
|
|
UpdateTopic(TopicResults[k].TopicIndex, High(TopicResults[k].LocationCodes), 0, j = 0);
|
|
// title results
|
|
for k := 0 to High(TitleResults) do
|
|
UpdateTopic(TitleResults[k].TopicIndex, 0, High(TitleResults[k].LocationCodes), j = 0);
|
|
|
|
// remove documents that don't have results
|
|
k := 0;
|
|
while k <= High(FoundTopics) do
|
|
begin
|
|
if FoundTopics[k].FoundForThisRound = False then
|
|
DeleteTopic(k)
|
|
else
|
|
begin
|
|
FoundTopics[k].FoundForThisRound := False;
|
|
Inc(k);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// clear out results that don't contain all the words we are looking for
|
|
|
|
// now lookup titles and urls to add to final search results
|
|
for j := 0 to High(FoundTopics) do
|
|
begin
|
|
try
|
|
DocURL := fChms.Chm[i].LookupTopicByID(FoundTopics[j].Topic, DocTitle);
|
|
//WriteLn(Docurl);
|
|
if DocTitle = '' then
|
|
Doctitle := 'untitled';
|
|
ListItem := fSearchResults.Items.Add;
|
|
ListItem.Caption := DocTitle;
|
|
ListItem.Data := fChms.Chm[i];
|
|
ListItem.SubItems.Add(IntToStr(FoundTopics[j].Hits));
|
|
ListItem.SubItems.Add(IntToStr(FoundTopics[j].TitleHits));
|
|
ListITem.SubItems.Add(DocURL);
|
|
except
|
|
//WriteLn('Exception');
|
|
// :)
|
|
end;
|
|
end;
|
|
|
|
SetLength(FoundTopics, 0);
|
|
end;
|
|
SetLength(FoundTopics, 0);
|
|
|
|
SearchWords.Free;
|
|
if fSearchResults.Items.Count = 0 then
|
|
begin
|
|
ListItem := fSearchResults.Items.Add;
|
|
ListItem.Caption := 'No Results';
|
|
end;
|
|
{ fSearchResults.SortColumn := 1; // causes the listview data to be mixed up!
|
|
fSearchResults.SortType := stNone;
|
|
fSearchResults.SortType := stText;
|
|
fSearchResults.SortColumn := 2;
|
|
fSearchResults.SortType := stNone;
|
|
fSearchResults.SortType := stText;}
|
|
fSearchResults.EndUpdate;
|
|
//WriteLn('THE DUDE');
|
|
end;
|
|
|
|
procedure TChmContentProvider.SearchResultsDblClick ( Sender: TObject ) ;
|
|
var
|
|
Item: TListItem;
|
|
begin
|
|
Item := fSearchResults.Selected;
|
|
if (Item = nil) or (Item.Data = nil) then
|
|
Exit;
|
|
|
|
DoLoadUri(MakeURI(Item.SubItems[2], TChmReader(Item.Data)));
|
|
end;
|
|
|
|
|
|
function TChmContentProvider.CanGoBack: Boolean;
|
|
begin
|
|
Result := fHistoryIndex > 0;
|
|
end;
|
|
|
|
function TChmContentProvider.CanGoForward: Boolean;
|
|
begin
|
|
Result := fHistoryIndex < fHistory.Count-1
|
|
end;
|
|
|
|
function TChmContentProvider.GetHistory: TStrings;
|
|
begin
|
|
Result:= fHistory;
|
|
end;
|
|
|
|
function TChmContentProvider.LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean;
|
|
var
|
|
fFile: String;
|
|
fURL: String = '';
|
|
fPos: Integer;
|
|
FileIndex: Integer;
|
|
LoadTOC: Boolean;
|
|
begin
|
|
Result := False;
|
|
fFile := Copy(AUrl,8, Length(AURL));
|
|
fPos := Pos('://', fFile);
|
|
if fPos > 0 then begin
|
|
fURL := Copy(fFile, fPos+3, Length(fFIle));
|
|
fFile := Copy(fFIle, 1, fPos-1);
|
|
end;
|
|
//writeln(fURL);
|
|
LoadTOC := (fChms = nil) or (fChms.IndexOf(fFile) < 0);
|
|
DoOpenChm(fFile, False);
|
|
FileIndex := fChms.IndexOf(fFile);
|
|
if fURL <> '' then
|
|
DoLoadUri(MakeURI(fURL, fChms.Chm[FileIndex]))
|
|
else
|
|
GoHome;
|
|
Result := True;
|
|
|
|
if LoadTOC and (FileIndex = 0) then
|
|
begin
|
|
Application.ProcessMessages;
|
|
Application.QueueAsyncCall(@FillToc, PtrInt(fChms.Chm[FileIndex]));
|
|
end;
|
|
fChms.OnOpenNewFile := @NewChmOpened;
|
|
end;
|
|
|
|
procedure TChmContentProvider.GoHome;
|
|
begin
|
|
if (fChms <> nil) and (fChms.Chm[0].DefaultPage <> '') then begin
|
|
DoLoadUri(MakeURI(fChms.Chm[0].DefaultPage, fChms.Chm[0]));
|
|
end;
|
|
end;
|
|
|
|
procedure TChmContentProvider.GoBack;
|
|
var
|
|
HistoryChm: TChmReader;
|
|
begin
|
|
if CanGoBack then begin
|
|
Dec(fHistoryIndex);
|
|
fIsUsingHistory:=True;
|
|
HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
|
|
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
|
|
end;
|
|
end;
|
|
|
|
procedure TChmContentProvider.GoForward;
|
|
var
|
|
HistoryChm: TChmReader;
|
|
begin
|
|
if CanGoForward then begin
|
|
Inc(fHistoryIndex);
|
|
fIsUsingHistory:=True;
|
|
HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
|
|
fChms.ObjectExists(fHistory.Strings[fHistoryIndex], HistoryChm); // this ensures that the correct chm will be found
|
|
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
|
|
end;
|
|
end;
|
|
|
|
class function TChmContentProvider.GetProperContentProvider(const AURL: String
|
|
): TBaseContentProviderClass;
|
|
begin
|
|
Result:=TChmContentProvider;
|
|
end;
|
|
|
|
constructor TChmContentProvider.Create(AParent: TWinControl);
|
|
const
|
|
TAB_WIDTH = 215;
|
|
begin
|
|
inherited Create(AParent);
|
|
|
|
fHistory := TStringList.Create;
|
|
|
|
fTabsControl := TPageControl.Create(AParent);
|
|
with fTabsControl do begin
|
|
Width := TAB_WIDTH + 12;
|
|
Align := alLeft;
|
|
Parent := AParent;
|
|
Visible := True;
|
|
end;
|
|
|
|
fContentsTab := TTabSheet.Create(fTabsControl);
|
|
with fContentsTab do begin
|
|
Caption := 'Contents';
|
|
Parent := fTabsControl;
|
|
Visible := True;
|
|
//BorderSpacing.Around := 6;
|
|
end;
|
|
fContentsPanel := TPanel.Create(fContentsTab);
|
|
with fContentsPanel do begin
|
|
Parent := fContentsTab;
|
|
Align := alClient;
|
|
Caption := 'Table of Contents Loading. Please Wait...';
|
|
Visible := True;
|
|
end;
|
|
fContentsTree := TTreeView.Create(fContentsPanel);
|
|
with fContentsTree do begin
|
|
Parent := fContentsPanel;
|
|
Align := alClient;
|
|
Visible := True;
|
|
OnSelectionChanged := @ContentsTreeSelectionChanged;
|
|
end;
|
|
|
|
fIndexTab := TTabSheet.Create(fTabsControl);
|
|
with fIndexTab do begin
|
|
Caption := 'Index';
|
|
Parent := fTabsControl;
|
|
Visible := True;
|
|
//BorderSpacing.Around := 6;
|
|
end;
|
|
|
|
fIndexEdit := TLabeledEdit.Create(fIndexTab);
|
|
with fIndexEdit do begin
|
|
Parent := fIndexTab;
|
|
Top := EditLabel.Height+9;
|
|
Left := 5;
|
|
Width := TAB_WIDTH;
|
|
Visible := True;
|
|
EditLabel.AutoSize := True;
|
|
LabelPosition := lpAbove;
|
|
BorderSpacing.Bottom := 15;
|
|
OnChange := @SearchEditChange;
|
|
EditLabel.Caption := 'Search';
|
|
Anchors := [akTop, akLeft, akRight];
|
|
end;
|
|
fIndexView := TListView.Create(fIndexTab);
|
|
with fIndexView do begin
|
|
Parent := fIndexTab;
|
|
Top := fIndexEdit.Top + fIndexEdit.Height + 10;
|
|
Left := 5;
|
|
Width := TAB_WIDTH;
|
|
Height := fIndexTab.Height-Top-6 ;
|
|
Align := alBottom;
|
|
BorderSpacing.Left := 6;
|
|
BorderSpacing.Right := 6;
|
|
Visible := True;
|
|
OnDblClick := @IndexViewDblClick;
|
|
Anchors := [akTop, akLeft, akRight, akBottom];
|
|
end;
|
|
|
|
fSearchTab := TTabSheet.Create(fTabsControl);
|
|
with fSearchTab do begin
|
|
Caption := 'Search';
|
|
Parent := fTabsControl;
|
|
Visible := True;
|
|
|
|
end;
|
|
fKeywordLabel := TLabel.Create(fSearchTab);
|
|
with fKeywordLabel do begin
|
|
Parent := fSearchTab;
|
|
Top := 5;
|
|
Caption := 'Keyword:';
|
|
Left := 5;
|
|
AutoSize := True;
|
|
end;
|
|
fKeywordCombo := TComboBox.Create(fSearchTab);
|
|
with fKeywordCombo do begin
|
|
Parent := fSearchTab;
|
|
Top := fKeywordLabel.Top + fKeywordLabel.Height + 5;
|
|
Left := 5;
|
|
Width := TAB_WIDTH;
|
|
Anchors := [akLeft, akRight, akTop];
|
|
end;
|
|
fSearchBtn := TButton.Create(fSearchTab);
|
|
with fSearchBtn do begin
|
|
Parent := fSearchTab;
|
|
Top := fKeywordCombo.Top + fKeywordCombo.Height + 5;
|
|
Width := 105;
|
|
Left := 5;
|
|
Anchors := [akTop, akRight];
|
|
Caption := 'Find';
|
|
OnClick := @SearchButtonClick;
|
|
end;
|
|
fResultsLabel := TLabel.Create(fSearchTab);
|
|
with fResultsLabel do begin
|
|
Parent := fSearchTab;
|
|
Top := fSearchBtn.Top + fSearchBtn.Height + 15;
|
|
Align := alBottom;
|
|
Caption := 'Search Results:';
|
|
BorderSpacing.Around := 6;
|
|
AutoSize := True;
|
|
end;
|
|
fSearchResults := TListView.Create(fSearchTab);
|
|
with fSearchResults do begin
|
|
Parent := fSearchTab;
|
|
Top := fResultsLabel.Top + fResultsLabel.Height + 5;
|
|
//Width := fSearchTab.Width - (Left * 2);
|
|
Height := fSearchTab.ClientHeight - Top;
|
|
Anchors := [akTop];
|
|
Align := alBottom;
|
|
BorderSpacing.Around := 6;
|
|
ShowColumnHeaders := False;
|
|
ViewStyle := vsReport;
|
|
Columns.Add.AutoSize := True; // title
|
|
Columns.Add.Visible := False; // topic hits
|
|
Columns.Add.Visible := False; // title hits
|
|
Columns.Add.Visible := False; // url
|
|
OnDblClick := @SearchResultsDblClick;
|
|
end;
|
|
|
|
fSplitter := TSplitter.Create(Parent);
|
|
with fSplitter do begin
|
|
Align := alLeft;
|
|
Parent := AParent
|
|
end;
|
|
|
|
fHtml := TIpHtmlPanel.Create(Parent);
|
|
with fHtml do begin
|
|
DataProvider := TIpChmDataProvider.Create(fHtml, fChms);
|
|
OnDocumentOpen := @IpHtmlPanelDocumentOpen;
|
|
OnHotChange := @IpHtmlPanelHotChange;
|
|
Parent := AParent;
|
|
Align := alClient;
|
|
end;
|
|
|
|
fPopUp := TPopupMenu.Create(fHtml);
|
|
fPopUp.Items.Add(TMenuItem.Create(fPopup));
|
|
with fPopUp.Items.Items[0] do begin
|
|
Caption := 'Copy';
|
|
OnClick := @PopupCopyClick;
|
|
end;
|
|
fHtml.PopupMenu := fPopUp;
|
|
|
|
fStatusBar := TStatusBar.Create(AParent);
|
|
with fStatusBar do begin
|
|
Parent := AParent;
|
|
Align := alBottom;
|
|
SimplePanel := True;
|
|
end;
|
|
end;
|
|
|
|
destructor TChmContentProvider.Destroy;
|
|
begin
|
|
DoCloseChm;
|
|
fHistory.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
initialization
|
|
|
|
RegisterFileType('.chm', TChmContentProvider);
|
|
|
|
end.
|
|
|