unit HTTPContentProvider; {$mode objfpc}{$H+} interface uses Classes, SysUtils, ComCtrls, Menus, Controls, IpHtml, BaseContentProvider, lhelpstrconsts; type { THTTPContentProvider } THTTPContentProvider = class(TBaseContentProvider) private fHomeUrl: String; fPopup: TPopupMenu; fStatusBar: TStatusBar; fHtml: TIpHtmlPanel; fHttpDataProvider: TIpHTTPDataProvider; procedure IpHtmlPanelHotChange(Sender: TObject); procedure PopupCopyClick(Sender: TObject); procedure SetTitle(ATitle: String); 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; procedure ActivateTOCControl; override; procedure ActivateIndexControl; override; procedure ActivateSearchControl; override; class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override; constructor Create(AParent: TWinControl; AImageList: TImageList; AUpdateCount:Integer); override; end; implementation { THTTPContentProvider } procedure THTTPContentProvider.IpHtmlPanelHotChange(Sender: TObject); begin fStatusBar.SimpleText := fHtml.HotURL; end; procedure THTTPContentProvider.PopupCopyClick(Sender: TObject); begin fHtml.CopyToClipboard; end; procedure THTTPContentProvider.SetTitle(ATitle: String); begin if Parent = nil then exit; TTabSheet(Parent).Caption := ATitle; end; function THTTPContentProvider.CanGoBack: Boolean; begin //Result:=inherited CanGoBack; fHtml.canGoBack; end; function THTTPContentProvider.CanGoForward: Boolean; begin //Result:=inherited CanGoForward; fHtml.canGoForward; end; function THTTPContentProvider.GetHistory: TStrings; begin //Result:=inherited GetHistory; end; function THTTPContentProvider.LoadURL(const AURL: String; const AContext: THelpContext): Boolean; begin Result:=True; SetTitle(Format(slhelp_Loading, [AURL]) ); //WriteLn('Loading URL:', AURL); fHtml.OpenURL(AURL); SetTitle(AURL); if fHomeURL = '' then fHomeURL := AURL; end; procedure THTTPContentProvider.GoHome; begin LoadURL(fHomeURL); end; procedure THTTPContentProvider.GoBack; begin fHtml.GoBack; end; procedure THTTPContentProvider.GoForward; begin fHtml.GoForward; end; procedure THTTPContentProvider.ActivateTOCControl; begin // end; procedure THTTPContentProvider.ActivateIndexControl; begin // end; procedure THTTPContentProvider.ActivateSearchControl; begin // end; procedure THTTPContentProvider.ProcGlobalKeyUp(var Key: Word; Shift: TShiftState ); begin // end; class function THTTPContentProvider.GetProperContentProvider(const AURL: String ): TBaseContentProviderClass; begin Result := THTTPContentProvider; end; constructor THTTPContentProvider.Create(AParent: TWinControl; AImageList: TImageList; AUpdateCount: Integer); begin inherited Create(AParent, AImageList, ); fPopUp := TPopupMenu.Create(fHtml); fPopUp.Items.Add(TMenuItem.Create(fPopup)); with fPopUp.Items.Items[0] do begin Caption := slhelp_Copy; OnClick := @PopupCopyClick; end; fHttpDataProvider := TIpHTTPDataProvider.Create(AParent); fHtml := TIpHtmlPanel.Create(Parent); with fHtml do begin DataProvider := fHttpDataProvider; OnDocumentOpen := @IpHtmlPanelDocumentOpen; OnHotChange := @IpHtmlPanelHotChange; PopupMenu := fPopUp; Parent := AParent; Align := alClient; Visible := True; end; fStatusBar := TStatusBar.Create(AParent); with fStatusBar do begin Parent := AParent; Align := alBottom; SimplePanel := True; end; end; initialization RegisterContentProvider('http://', THTTPContentProvider); end.