kolmck/Addons/mckWebBrowser.pas

//////////////////////////////////////////////////////////////////////////////////
//										//
//										//
//		TKOLWebBrowser v1.0						//
//										//
//	Author: Dimaxx (dimaxx@atnet.ru)					//
//										//
//										//
//////////////////////////////////////////////////////////////////////////////////

unit mckWebBrowser;

interface

uses Classes, Kol, Mirror;

type
  TWebBrowserStatusTextChange = procedure(Sender: TObject; const Text: WideString) of object;
  TWebBrowserProgressChange = procedure(Sender: TObject; Progress: Integer; ProgressMax: Integer) of object;
  TWebBrowserCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;
  TWebBrowserTitleChange = procedure(Sender: TObject; const Text: WideString) of object;
  TWebBrowserPropertyChange = procedure(Sender: TObject; const szProperty: WideString) of object;
  TWebBrowserBeforeNavigate2 = procedure(Sender: TObject; const pDisp: IDispatch;
                                                          var URL: OleVariant;
                                                          var Flags: OleVariant;
                                                          var TargetFrameName: OleVariant;
                                                          var PostData: OleVariant;
                                                          var Headers: OleVariant;
                                                          var Cancel: WordBool) of object;
  TWebBrowserNewWindow2 = procedure(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool) of object;
  TWebBrowserNavigateComplete2 = procedure(Sender: TObject; const pDisp: IDispatch;
                                                            var URL: OleVariant) of object;
  TWebBrowserDocumentComplete = procedure(Sender: TObject; const pDisp: IDispatch;
                                                           var URL: OleVariant) of object;
  TWebBrowserOnVisible = procedure(Sender: TObject; Visible: WordBool) of object;
  TWebBrowserOnToolBar = procedure(Sender: TObject; ToolBar: WordBool) of object;
  TWebBrowserOnMenuBar = procedure(Sender: TObject; MenuBar: WordBool) of object;
  TWebBrowserOnStatusBar = procedure(Sender: TObject; StatusBar: WordBool) of object;
  TWebBrowserOnFullScreen = procedure(Sender: TObject; FullScreen: WordBool) of object;
  TWebBrowserOnTheaterMode = procedure(Sender: TObject; TheaterMode: WordBool) of object;

  TKOLWebBrowser = class(TKOLCustomControl)
  private
    FOnStatusTextChange: TWebBrowserStatusTextChange;
    FOnProgressChange: TWebBrowserProgressChange;
    FOnCommandStateChange: TWebBrowserCommandStateChange;
    FOnTitleChange: TWebBrowserTitleChange;
    FOnPropertyChange: TWebBrowserPropertyChange;
    FOnBeforeNavigate2: TWebBrowserBeforeNavigate2;
    FOnNewWindow2: TWebBrowserNewWindow2;
    FOnNavigateComplete2: TWebBrowserNavigateComplete2;
    FOnDocumentComplete: TWebBrowserDocumentComplete;
    FOnVisible: TWebBrowserOnVisible;
    FOnToolBar: TWebBrowserOnToolBar;
    FOnMenuBar: TWebBrowserOnMenuBar;
    FOnStatusBar: TWebBrowserOnStatusBar;
    FOnFullScreen: TWebBrowserOnFullScreen;
    FOnTheaterMode: TWebBrowserOnTheaterMode;

    FOffline: boolean;
    FSilent: boolean;
    FRegisterAsBrowser: boolean;
    FRegisterAsDropTarget: boolean;
  protected
    function AdditionalUnits: string; override;
    procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
    procedure AssignEvents(SL: TStringList; const AName: string); override;
    procedure SetOnStatusTextChange(E: TWebBrowserStatusTextChange);
    procedure SetOnProgressChange(E: TWebBrowserProgressChange);
    procedure SetOnCommandStateChange(E: TWebBrowserCommandStateChange);
    procedure SetOnTitleChange(E: TWebBrowserTitleChange);
    procedure SetOnPropertyChange(E: TWebBrowserPropertyChange);
    procedure SetOnBeforeNavigate2(E: TWebBrowserBeforeNavigate2);
    procedure SetOnNewWindow2(E: TWebBrowserNewWindow2);
    procedure SetOnNavigateComplete2(E: TWebBrowserNavigateComplete2);
    procedure SetOnDocumentComplete(E: TWebBrowserDocumentComplete);
    procedure SetOnVisible(E: TWebBrowserOnVisible);
    procedure SetOnToolBar(E: TWebBrowserOnToolBar);
    procedure SetOnMenuBar(E: TWebBrowserOnMenuBar);
    procedure SetOnStatusBar(E: TWebBrowserOnStatusBar);
    procedure SetOnFullScreen(E: TWebBrowserOnFullScreen);
    procedure SetOnTheaterMode(E: TWebBrowserOnTheaterMode);

    procedure SetOffline(V: boolean);
    procedure SetSilent(V: boolean);
    procedure SetRegisterAsBrowser(V: boolean);
    procedure SetRegisterAsDropTarget(V: boolean);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Visible;
    property TabStop;
    property TabOrder;
    property OnEnter;
    property OnExit;

    property Offline: boolean read FOffline write SetOffline default True;
    property Silent: boolean read FSilent write SetSilent default False;
    property RegisterAsBrowser: boolean read FRegisterAsBrowser write SetRegisterAsBrowser default True;
    property RegisterAsDropTarget: boolean read FRegisterAsDropTarget write SetRegisterAsDropTarget default False;

    property OnStatusTextChange: TWebBrowserStatusTextChange read FOnStatusTextChange write SetOnStatusTextChange;
    property OnProgressChange: TWebBrowserProgressChange read FOnProgressChange write SetOnProgressChange;
    property OnCommandStateChange: TWebBrowserCommandStateChange read FOnCommandStateChange write SetOnCommandStateChange;
    property OnTitleChange: TWebBrowserTitleChange read FOnTitleChange write SetOnTitleChange;
    property OnPropertyChange: TWebBrowserPropertyChange read FOnPropertyChange write SetOnPropertyChange;
    property OnBeforeNavigate2: TWebBrowserBeforeNavigate2 read FOnBeforeNavigate2 write SetOnBeforeNavigate2;
    property OnNewWindow2: TWebBrowserNewWindow2 read FOnNewWindow2 write SetOnNewWindow2;
    property OnNavigateComplete2: TWebBrowserNavigateComplete2 read FOnNavigateComplete2 write SetOnNavigateComplete2;
    property OnDocumentComplete: TWebBrowserDocumentComplete read FOnDocumentComplete write SetOnDocumentComplete;
    property OnVisible: TWebBrowserOnVisible read FOnVisible write SetOnVisible;
    property OnToolBar: TWebBrowserOnToolBar read FOnToolBar write SetOnToolBar;
    property OnMenuBar: TWebBrowserOnMenuBar read FOnMenuBar write SetOnMenuBar;
    property OnStatusBar: TWebBrowserOnStatusBar read FOnStatusBar write SetOnStatusBar;
    property OnFullScreen: TWebBrowserOnFullScreen read FOnFullScreen write SetOnFullScreen;
    property OnTheaterMode: TWebBrowserOnTheaterMode read FOnTheaterMode write SetOnTheaterMode;
  end;

  procedure Register;

{$R *.dcr}

implementation

const
  AlignValues: array[TKOLAlign] of string = ('caNone','caLeft','caTop','caRight','caBottom','caClient');
  Bool2Str: array [Boolean] of string = ('False','True');

procedure Register;
begin
  RegisterComponents('KOLAddons',[TKOLWebBrowser]);
end;

constructor TKOLWebBrowser.Create;
begin
  inherited;
  FOffline:=True;
  FSilent:=True;
  FRegisterAsBrowser:=True;
  FRegisterAsDropTarget:=False;
end;

function TKOLWebBrowser.AdditionalUnits;
begin
  Result:=', KOLWebBrowser';
end;

procedure TKOLWebBrowser.SetupFirst;
begin
  SL.Add(Prefix+AName+' := NewKOLWebBrowser(Result.Form); ');
  if Align<>caNone then
    begin
      SL.Add(Prefix+AName+'.SetAlign( '+AlignValues[Align]+'); ');
    end
  else
    begin
      SL.Add(Prefix+AName+'.SetPosition(' +int2str(Left)+', '+int2str(Top)+' );');
      SL.Add(Prefix+AName+'.SetSize(' +int2str(Width)+', '+int2str(Height)+' );');
    end;
  SL.Add(Prefix+AName+'.Offline := '+Bool2Str[FOffline]+';');
  SL.Add(Prefix+AName+'.Silent := '+Bool2Str[FSilent]+';');
  SL.Add(Prefix+AName+'.RegisterAsBrowser := '+Bool2Str[FRegisterAsBrowser]+';');
  SL.Add(Prefix+AName+'.RegisterAsDropTarget := '+Bool2Str[FRegisterAsDropTarget]+';');
  AssignEvents(SL,AName);
end;

procedure TKOLWebBrowser.AssignEvents;
begin
  inherited;
  DoAssignEvents(SL,AName,
    ['OnStatusTextChange','OnProgressChange','OnCommandStateChange',
     'OnTitleChange','OnPropertyChange','OnBeforeNavigate2','OnNewWindow2',
     'OnNavigateComplete2','OnDocumentComplete','OnVisible','OnToolBar',
     'OnMenuBar','OnStatusBar','OnFullScreen','OnTheaterMode'],
    [@OnStatusTextChange,@OnProgressChange,@OnCommandStateChange,
     @OnTitleChange,@OnPropertyChange,@OnBeforeNavigate2,@OnNewWindow2,
     @OnNavigateComplete2,@OnDocumentComplete,@OnVisible,@OnToolBar,
     @OnMenuBar,@OnStatusBar,@OnFullScreen,@OnTheaterMode]);
end;

procedure TKOLWebBrowser.SetOffline;
begin
  FOffline:=V;
  Change;
end;

procedure TKOLWebBrowser.SetSilent;
begin
  FSilent:=V;
  Change;
end;

procedure TKOLWebBrowser.SetRegisterAsBrowser;
begin
  FRegisterAsBrowser:=V;
  Change;
end;

procedure TKOLWebBrowser.SetRegisterAsDropTarget;
begin
  FRegisterAsDropTarget:=V;
  Change;
end;

procedure TKOLWebBrowser.SetOnStatusTextChange;
begin
  FOnStatusTextChange:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnProgressChange;
begin
  FOnProgressChange:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnCommandStateChange;
begin
  FOnCommandStateChange:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnTitleChange;
begin
  FOnTitleChange:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnPropertyChange;
begin
  FOnPropertyChange:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnBeforeNavigate2;
begin
  FOnBeforeNavigate2:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnNewWindow2;
begin
  FOnNewWindow2:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnNavigateComplete2;
begin
  FOnNavigateComplete2:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnDocumentComplete;
begin
  FOnDocumentComplete:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnVisible;
begin
  FOnVisible:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnToolBar;
begin
  FOnToolBar:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnMenuBar;
begin
  FOnMenuBar:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnStatusBar;
begin
  FOnStatusBar:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnFullScreen;
begin
  FOnFullScreen:=E;
  Change;
end;

procedure TKOLWebBrowser.SetOnTheaterMode;
begin
  FOnTheaterMode:=E;
  Change;
end;

end.