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 RegisterContentProvidernull64function 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 GetContentProvidernull72function 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 GetContentProviderListnull83function GetContentProviderList: TStringList; 84 begin 85 Result := TStringList.Create; 86 Result.AddStrings(ContentProviders); 87 end; 88 89 90 91 { TBaseContentProvider } 92 TBaseContentProvider.GetTitlenull93function 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.IsUpdatingnull105function 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