unit WebBrowserHandle;

interface

uses
  Forms, Controls, Classes, ActiveX, OleCtrls, SHDocVw, Rubies, contnrs;

type
  TWebBrowserHandle = class(TObject)
  published
    procedure doBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant;
      var Flags: OleVariant; var TargetFrameName: OleVariant;
      var PostData: OleVariant; var Headers: OleVariant;
      var Cancel: WordBool);
    procedure doCommandStateChange(Sender: TObject;
      Command: Integer; Enable: WordBool);
    procedure doDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure NotifyOnDownloadBegin(Sender: TObject);
    procedure NotifyOnDownloadComplete(Sender: TObject);
    procedure doNavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure doNewWindow2(Sender: TObject;
      var ppDisp: IDispatch; var Cancel: WordBool);
    procedure doProgressChange(Sender: TObject;
      Progress: Integer; ProgressMax: Integer);
    procedure doTitleChange(Sender: TObject; const Text: WideString);
    procedure doVisible(Sender: TObject; Visible: WordBool);
  end;

var
  Handle: TWebBrowserHandle;
  rb_eWebBrowserError, cWebBrowser: Tvalue;

implementation

uses Pythia;

procedure TWebBrowserHandle.doBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant;
  var Flags: OleVariant; var TargetFrameName: OleVariant;
  var PostData: OleVariant; var Headers: OleVariant;
  var Cancel: WordBool);
var
  recv, data: Tvalue;
  ary, ret, val: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_before_navigate2'));
  rb_ary_push(data, recv);
  ary := rb_ary_new;
  rb_ary_push(ary, ap_Variant(URL));
  rb_ary_push(ary, ap_Variant(TargetFrameName));
  rb_ary_push(ary, ap_Variant(PostData));
  rb_ary_push(ary, ap_Variant(Headers));

  rb_ary_push(ary, ap_bool(Cancel));
  rb_ary_push(data, ary);
  ret := PhiCallProtect(data);
  if RTYPE(ret) <> T_ARRAY then Exit;
  val := rb_ary_shift(ret);
  URL := dl_Variant(val);
  val := rb_ary_shift(ret);
  TargetFrameName := dl_Variant(val);
  val := rb_ary_shift(ret);
  PostData := dl_Variant(val);
  val := rb_ary_shift(ret);
  Headers := dl_Variant(val);
  val := rb_ary_shift(ret);
  Cancel := RTEST(val);
end;

procedure TWebBrowserHandle.doCommandStateChange(Sender: TObject;
  Command: Integer; Enable: WordBool);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_command_state_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Fixnum(Command));
  rb_ary_push(data, ap_bool(Enable));
  PhiCallProtect(data);
end;

procedure TWebBrowserHandle.doDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_document_complete'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Variant(URL));
  ret := PhiCallProtect(data);
  if ret <> Qnil then URL := dl_Variant(ret);
end;

procedure TWebBrowserHandle.NotifyOnDownloadBegin(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_download_begin');
end;

procedure TWebBrowserHandle.NotifyOnDownloadComplete(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_download_complete');
end;

procedure TWebBrowserHandle.doNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_navigate_complete2'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Variant(URL));
  ret := PhiCallProtect(data);
  if ret <> Qnil then URL := dl_Variant(ret);
end;

procedure TWebBrowserHandle.doNewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_new_window2'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Cancel));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Cancel := RTEST(ret);
end;

procedure TWebBrowserHandle.doProgressChange(Sender: TObject;
  Progress: Integer; ProgressMax: Integer);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_progress_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Fixnum(Progress));
  rb_ary_push(data, ap_Fixnum(ProgressMax));
  PhiCallProtect(data);
end;

procedure TWebBrowserHandle.doTitleChange(Sender: TObject; const Text: WideString);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_title_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_String(Text));
  PhiCallProtect(data);
end;

procedure TWebBrowserHandle.doVisible(Sender: TObject; Visible: WordBool);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_visible'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Visible));
  PhiCallProtect(data);
end;

initialization
  Handle := TWebBrowserHandle.Create;
finalization
  Handle.Free;
end.
