mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-03 23:43:49 +02:00
65148452ac
* fixed a crash when loading a chm with no Table of contents * improved the Index tab to have a search feature * now the index tab indents subitems properly * removed dependancy of chmpkg. these files are included with fpc by default now. If you have an olderversion of fpc you can re-add the dependancy of chmpkg locally * added probably 5 new bugs :) git-svn-id: trunk@13211 -
117 lines
2.5 KiB
ObjectPascal
117 lines
2.5 KiB
ObjectPascal
unit filecontentprovider;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Controls, SysUtils, BaseContentProvider;
|
|
|
|
type
|
|
|
|
{ TFileContentProvider }
|
|
|
|
TFileContentProvider = class(TBaseContentProvider)
|
|
private
|
|
|
|
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;
|
|
end;
|
|
function RegisterFileType(const FileType: String; ContentProvider: TBaseContentProviderClass): Boolean;
|
|
|
|
implementation
|
|
|
|
var
|
|
FileContentProviders: TStringList;
|
|
|
|
function RegisterFileType(const FileType: String;
|
|
ContentProvider: TBaseContentProviderClass): Boolean;
|
|
begin
|
|
Result := False;
|
|
if FileContentProviders.IndexOf(FileType) > -1 then exit;
|
|
FileContentProviders.AddObject(FileType, TObject(ContentProvider));
|
|
end;
|
|
|
|
{ TFileContentProvider }
|
|
|
|
function TFileContentProvider.CanGoBack: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TFileContentProvider.CanGoForward: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TFileContentProvider.GetHistory: TStrings;
|
|
begin
|
|
Result:= nil;
|
|
end;
|
|
|
|
function TFileContentProvider.LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TFileContentProvider.GoHome;
|
|
begin
|
|
end;
|
|
|
|
procedure TFileContentProvider.GoBack;
|
|
begin
|
|
end;
|
|
|
|
procedure TFileContentProvider.GoForward;
|
|
begin
|
|
end;
|
|
|
|
class function TFileContentProvider.GetProperContentProvider(const AURL: String
|
|
): TBaseContentProviderClass;
|
|
var
|
|
fIndex: Integer;
|
|
fExt: String;
|
|
fFile: String;
|
|
fPos: Integer;
|
|
begin
|
|
Result := nil;
|
|
fFile := Copy(AUrl,8, Length(AURL));
|
|
fPos := Pos('://', fFile);
|
|
if fPos > 0 then begin
|
|
fFile := Copy(fFIle, 1, fPos-1);
|
|
|
|
end;
|
|
fExt := ExtractFileExt(fFile);
|
|
|
|
//WriteLn(fExt);
|
|
fIndex := FileContentProviders.IndexOf(fExt);
|
|
if fIndex = -1 then exit;
|
|
Result := TBaseContentProviderClass(FileContentProviders.Objects[fIndex]);
|
|
end;
|
|
|
|
constructor TFileContentProvider.Create(AParent: TWinControl);
|
|
begin
|
|
inherited Create(AParent);
|
|
end;
|
|
|
|
initialization
|
|
|
|
FileContentProviders := TStringList.Create;
|
|
RegisterContentProvider('file://', TFileContentProvider);
|
|
|
|
finalization
|
|
|
|
FileContentProviders.Free;
|
|
|
|
end.
|
|
|