1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
|
unit BaseContentProvider;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Laz2_XMLCfg;
type
{ TBaseContentProvider }
TBaseContentProviderClass = Class of TBaseContentProvider;
TBaseContentProvider = class(TObject)
private
FOnTitleChange: TNotifyEvent;
fParent: TWinControl;
FTitle: String;
FConfig: TXMLConfig;
FUpdateCount: Integer;
protected
fImageList: TImageList;
function GetTitle: String; virtual;
procedure SetTitle(const AValue: String); virtual;
function IsUpdating: Boolean;
public
function CanGoBack: Boolean; virtual; abstract;
function CanGoForward: Boolean; virtual; abstract;
function GetHistory: TStrings; virtual; abstract;
function LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; virtual; abstract;
procedure GoHome; virtual; abstract;
procedure GoBack; virtual; abstract;
procedure GoForward; virtual; abstract;
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
procedure LoadPreferences(ACfg: TXMLConfig); virtual;
procedure SavePreferences({%H-}ACfg: TXMLConfig); virtual;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract;
constructor Create(AParent: TWinControl; AImageList: TImageList); virtual;
destructor Destroy; override;
property Parent: TWinControl read fParent;
property Title: String read GetTitle write SetTitle;
property OnTitleChange: TNotifyEvent read FOnTitleChange write FOnTitleChange;
end;
// returns false if the protocol has already been registered
function RegisterContentProvider(const Protocol: String; ContentProvider: TBaseContentProviderClass): Boolean;
// example: RegisterContentProvider('chm://', TChmContentProvider);
function GetContentProvider(const Protocol: String): TBaseContentProviderClass;
// Result must be freed by caller
function GetContentProviderList: TStringList;
implementation
var
ContentProviders: TStringList;
function RegisterContentProvider(const Protocol: String;
ContentProvider: TBaseContentProviderClass): Boolean;
begin
Result := False;
if ContentProviders.IndexOf(Protocol) > -1 then exit;
ContentProviders.AddObject(Protocol, TObject(ContentProvider));
end;
function GetContentProvider(const Protocol: String): TBaseContentProviderClass;
var
fIndex: Integer;
begin
Result := nil;
fIndex := ContentProviders.IndexOf(Protocol);
if fIndex = -1 then Exit;
Result := TBaseContentProviderClass(ContentProviders.Objects[fIndex]);
end;
function GetContentProviderList: TStringList;
begin
Result := TStringList.Create;
Result.AddStrings(ContentProviders);
end;
{ TBaseContentProvider }
function TBaseContentProvider.GetTitle: String;
begin
Result := FTitle;
end;
procedure TBaseContentProvider.SetTitle(const AValue: String);
begin
FTitle := AValue;
if Assigned(FOnTitleChange) then
FOnTitleChange(Self);
end;
function TBaseContentProvider.IsUpdating: Boolean;
begin
Result := FUpdateCount <> 0;
end;
procedure TBaseContentProvider.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TBaseContentProvider.EndUpdate;
begin
Dec(FUpdateCount);
if FUpdateCount < 0 then
FUpdateCount:=0;
end;
procedure TBaseContentProvider.LoadPreferences(ACfg: TXMLConfig);
begin
FConfig := ACfg;
end;
procedure TBaseContentProvider.SavePreferences(ACfg: TXMLConfig);
begin
end;
constructor TBaseContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
begin
fParent:= AParent;
fImageList:= AImageList;
end;
destructor TBaseContentProvider.Destroy;
begin
SavePreferences(FConfig);
inherited Destroy;
end;
initialization
ContentProviders := TStringList.Create;
finalization
ContentProviders.Free;
end.
|