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