unit frmwebbrowse;

interface

uses
  AnyQBase,
  XMLTag, ChatWin, UDP, Contnrs, mshtml, IeConst,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Buttons, StdCtrls, ToolWin, OleCtrls, SHDocVw, ImgList,
  SHDocVw_TLB, ExtCtrls, EmbeddedWB;

type
  TCoBrowseFrom = class(TAnyQBaseForm)
    coolbarTools: TCoolBar;
    ToolBar1: TToolBar;
    coboxUrl: TComboBox;
    sbGoto: TSpeedButton;
    ToolButton1: TToolButton;
    tbBack: TToolButton;
    tbForward: TToolButton;
    tbStop: TToolButton;
    tbrefresh: TToolButton;
    ImageList1: TImageList;
    ToolButton6: TToolButton;
    tbDraw: TToolButton;
    cbColor: TColorBox;
    tbClear: TToolButton;
    webView: TEmbeddedWB;
    ScrollBarV: TScrollBar;
    ScrollBarH: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure coboxUrlKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sbGotoClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tbBackClick(Sender: TObject);
    procedure tbForwardClick(Sender: TObject);
    procedure WebViewBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure NewWebViewBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure webViewNewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure WebViewDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormDestroy(Sender: TObject);
    procedure WebViewNavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure tbClearClick(Sender: TObject);
    function webViewGetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
    procedure ScrollBarVChange(Sender: TObject);
    procedure ScrollBarHChange(Sender: TObject);
    function webViewShowContextMenu(const dwID: Cardinal;
      const ppt: PPoint; const pcmdtReserved: IInterface;
      const pdispReserved: IDispatch): HRESULT;
    procedure tbrefreshClick(Sender: TObject);
    procedure tbStopClick(Sender: TObject);
  private
    { Private declarations }
    openurl: OleVariant;
    newurl: OleVariant;
    CanOpenNew: Boolean;
    completed: boolean;
    toJID: widestring;
    BrowsID: TGUID;
    IsHost: Boolean;
    IsReady: Boolean;

    oldweblong: TFarProc;
    webHandle: THandle;

    procedure GetTypedUrls;
    procedure UpDateTypedUrls;
    procedure BrowseCallback(event: string; tag: TXMLTag);
    procedure webWndProc(var Message: TMessage);
  public
    { Public declarations }
    _ChatForm: TCustomForm;
    _SID: widestring;
    _DrawList: TobjectList;
    procedure doscroll(scrollstr: string);
    procedure SendBrowse;
    procedure sendBrowsecmd(cmd:string; const content: string = '');
    procedure go(url:string);
  end;

var
  CoBrowseFrom: TCoBrowseFrom;

procedure AnyQBrowsReceive(tag: TXMLTag);
function startBrows(chat: TfrmChat; tojid: widestring): TCoBrowseFrom;
function starrcvtBrows(browseid: TGuid; chat: TfrmChat; tojid: widestring): TCoBrowseFrom;

implementation

uses activex, Registry, shellapi, shlobj, IQ, JabberID, Presence, Session,
  RiserWindow, JabberConst, Jabber1;

{$R *.dfm}

Type
  TAnyQWebDraw = class
  private

  public
    Color: TColor;
    PathList: Tlist;
    constructor Create;
    destructor Destroy; override;
  end;

function DrawToStr(Draw: TAnyQWebDraw):string;
var
  i: Integer;
begin
  Result := '';
  if Draw.PathList.Count <=2 then
    exit;
  Result := IntToHex(Draw.Color,8);
  for i:= 0 to Draw.PathList.Count-1 do
    Result := Result+IntToHex(Integer(Draw.PathList.items[i]),8);
end;

function StrToDraw(str: string): TAnyQWebDraw;
var
  i: Integer;
  v: string;
begin
  Result := TAnyQWebDraw.Create;
  try
    v := copy(str,1,8);
    Result.Color := Tcolor(StrToInt('$'+v));
    for i := 1 to (length(str) div 8)-1 do
    begin
      v := copy(str,i*8+1,8);
      Result.PathList.Add(Pointer(StrToInt('$'+v)));
    end;
  except
    Result.free;
    Result := nil;
  end;
end;

function SHAutoComplete(hwndEdit: HWND; dwFlags: DWORD): HRESULT; stdcall; external 'shlwapi.dll';

type
  TUrlCombox = class(TCustomComboBox);

procedure Senderror(tojid, id: string);
var
  iq: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  with iq do begin
    setAttribute('to', tojid);
    setAttribute('id', id);
    setAttribute('type', 'error');
    AddBasicTag('error', '同步错误').setAttribute('code', '406');
  end;
  MainSession.SendTag(iq);
end;

procedure Sendresult(tojid, id: string);
var
  iq: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  with iq do begin
    setAttribute('to', tojid);
    setAttribute('id', id);
    setAttribute('type', 'result');
  end;
  MainSession.SendTag(iq);
end;

procedure AnyQBrowsReceive(tag: TXMLTag);
var
  qTag, tmp_tag: TXMLTag;
  from, ID: string;
  browseid: TGuid;
  i: integer;
  frm: TCoBrowseFrom;
  url: string;
  Draw: TAnyQWebDraw;
  Rect: TRect;
begin
  // Callback for receiving file transfers
  from := tag.GetAttribute('from');
  ID := tag.GetAttribute('id');
  qTag := tag.getFirstTag('query');
  if tag.GetAttribute('type') <> 'set' then
    exit;

  if not qtag.TagExists('webid') then exit;
  browseid := StringToGUID(qtag.GetBasicText('webid'));

  frm := nil;
  for i :=  Application.ComponentCount-1 downto 0 do
  begin
    if not (Application.Components[i] is TCoBrowseFrom) then
      Continue;
    if IsEqualGUID(TCoBrowseFrom(Application.Components[i]).BrowsID, browseid) then
    begin
      frm := TCoBrowseFrom(Application.Components[i]);
      break;
    end;
  end;

  if frm = nil then
  begin
    if qtag.TagExists('open') then
    begin
      StartwebChat(from, id, browseid);
      SendResult(from, id);
      exit;
    end
    else begin
      exit;
    end;
  end;

  if qtag.TagExists('close') then  //关闭
  begin
    ShowRiserWindow(nil,'对方已经终止共同浏览。',ico_info);
    SendResult(from, id);
    frm.Close;
    exit;
  end;

  if qtag.TagExists('draw') then  //画线
  begin
    Draw := StrToDraw(qtag.GetBasicText('draw'));
    if Draw<>nil then
    begin
      frm._DrawList.Add(draw);
      Rect := frm.webView.ClientRect;
      InvalidateRect(frm.webHandle, @Rect ,true);
    end;
    SendResult(from, id);
    exit;
  end;

  if qtag.TagExists('clear') then  //清除画线
  begin
    frm._DrawList.Clear;
    Rect := frm.webView.ClientRect;
    InvalidateRect(frm.webHandle, @Rect ,true);
    SendResult(from, id);
    exit;
  end;

  if qtag.TagExists('scroll') then  //滚动
  begin
    frm.doscroll(qtag.GetBasicText('scroll'));
    SendResult(from, id);
    exit;
  end;

  try
    if qtag.TagExists('url') then
    begin
      url := qtag.GetBasicText('url');
      frm.go(url);
    end;
    SendResult(from, id);
  except
    ShowRiserWindow(nil, '同步过程出现错误，共同浏览网页终止。', ico_info);
    frm.sendBrowsecmd('close');
    frm.Close;
  end;
end;

function startBrows(chat: TfrmChat; tojid: widestring): TCoBrowseFrom;
var
  frm: TCoBrowseFrom;
begin
  Result := nil;
  frm := TCoBrowseFrom.Create(Application);
  frm.IsHost := True;

  chat._webForm := frm;
  frm._ChatForm := chat;

//  frm.IsHost := True;
  frm.toJID := tojid;
  frm.SendBrowse;
  frm.show;
{  frm._extForm := TFrmPPTExt.Create(application);
  frm._extForm.Parent := chat.pnlchat;
  frm._extForm.Top := chat.pnlchat.Height;
  frm._extForm.Show;
  TFrmPPTExt(pptfrm._extForm)._ConsoleForm := pptfrm;   {}
end;

function starrcvtBrows(browseid: TGuid; chat: TfrmChat; tojid: widestring): TCoBrowseFrom;
var
  frm: TCoBrowseFrom;
begin
  Result := nil;
  frm := TCoBrowseFrom.Create(Application);
  frm.IsHost := False;
  frm.coolbarTools.Enabled := False;

  chat._webForm := frm;
  frm._ChatForm := chat;

  frm.toJID := tojid;
  frm.BrowsID := browseid;
  frm.show;
end;

procedure TCoBrowseFrom.FormCreate(Sender: TObject);
begin
  _DrawList := TObjectList.Create;
  CanOpenNew := True;
  openurl := '';
  GetTypedUrls;
  webView.Navigate('about:blank');
  webHandle := INVALID_HANDLE_VALUE;
end;

procedure TCoBrowseFrom.UpDateTypedUrls;  
var
  Max, Counter: Integer;
  Name: string;
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', True) then begin
      if coboxUrl.Items.Count < 24 then Max := coboxUrl.Items.Count + 1 else Max := 25;
      for Counter := 1 to Max do begin
        Name := 'Url' + IntToStr(Counter);
        Reg.WriteString(Name, coboxUrl.items[Counter - 1]);
      end;
    end;
    reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

procedure TCoBrowseFrom.GetTypedUrls;
var
  Counter : Integer;
  S : String;
begin
  coboxUrl.Items.Clear;
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', FALSE) then begin
      for Counter := 1 to 25 do begin
        if ValueExists('Url' +  IntToStr(Counter)) then begin
          S := ReadString('Url' + IntToStr(Counter));
          if S <> '' then coboxUrl.Items.Add(S);
        end;
      end;
    end;
  finally
    Free;
  end;
end;

procedure TCoBrowseFrom.coboxUrlKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  FListIndex: integer;
begin
  if Key=VK_return then
    if coboxUrl.DroppedDown then
    begin
      Key := VK_CLEAR;
      FListIndex:=SendMessage(coboxUrl.Handle, CB_GETCURSEL, 0,0);
      coboxUrl.Items.Move(FListIndex,0);
      coboxUrl.Text:= coboxUrl.Items[0];
      sendmessage(coboxUrl.Handle,CB_SHOWDROPDOWN,0,0);
      SendMessage(coboxUrl.handle, CB_SETCURSEL, 0,0);
      SendMessage(TUrlCombox(coboxUrl).Edithandle, EM_SETREADONLY, 0, 0);
      SendMessage(TUrlCombox(coboxUrl).EditHandle, EM_SETSEL, 0, -1);
    end
    else
    begin
      sbGoto.Click;
    end;
end;

procedure TCoBrowseFrom.sbGotoClick(Sender: TObject);
begin
  CanOpenNew := True;
  completed := True;
  WebView.Navigate(coboxUrl.Text);
  coboxUrl.Items.Insert(0, coboxUrl.Text);
  UpdateTypedUrls;
end;

procedure TCoBrowseFrom.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if _ChatForm <> nil then
    if not (csDestroying in _ChatForm.ComponentState) then
      TfrmChat(_ChatForm)._webForm := nil;
  _ChatForm := nil;
  sendBrowsecmd('close');
  if webHandle<>INVALID_HANDLE_VALUE then
    SetWindowLong(webHandle, GWL_WNDPROC, Integer(oldweblong));
  Action := caFree;
end;

procedure TCoBrowseFrom.tbBackClick(Sender: TObject);
begin
  CanOpenNew := True;
  completed := True;
  WebView.GoBack;
end;

procedure TCoBrowseFrom.tbForwardClick(Sender: TObject);
begin
  CanOpenNew := True;
  completed := True;
  WebView.GoForward;
end;

procedure TCoBrowseFrom.WebViewBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if not CanOpenNew then
  begin
    exit;
  end;
  if not completed then
  begin
    exit;
  end;

  _DrawList.Clear;
  CanOpenNew := False;
  completed := False;
  openurl := url;
  ScrollBarV.Position := 0;
  ScrollBarH.Position := 0;
  if IsHost  then
      sendBrowsecmd('url',url);
end;

procedure TCoBrowseFrom.webViewNewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
var
  WebBrowser : TEmbeddedWB;
  function Geturl: OleVariant;
  var
    i: Integer;
  begin
    Result := NULL;
    Result := (webView.Document as IHTMLDocument2).activeElement.getAttribute('href',0);
    if Result<>NULL then
      exit;
    try
      for i:= 0 to webView.FrameCount-1 do
      begin
        try
          if webView.GetFrame(i)=nil then Continue;
          Result := (webView.GetFrame(i).Document as IHTMLDocument2).activeElement.getAttribute('href',0);
          if Result <> NULL then
            exit;
        except
          Continue;
        end;
      end;
    except
    end;  
  end;
begin
  if not CanOpenNew then
  begin
    Cancel := true;
    exit;
  end;

  if webView.ReadyState <> READYSTATE_COMPLETE then
  begin
    Cancel := true;
    exit;
  end;

  newurl := Geturl;
  if newurl=Null then
  begin
    Cancel := true;
    exit;
  end;

  WebBrowser := TEmbeddedWB.Create(nil);
  ppDisp := WebBrowser.Application;
  WebBrowser.OnBeforeNavigate2 := NewWebViewBeforeNavigate2;
end;

procedure TCoBrowseFrom.NewWebViewBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if URL = newurl then
  begin
    CanOpenNew := True;
    completed := True;
    WebView.Navigate2(url);
  end;
  Cancel := True;
end;

procedure TCoBrowseFrom.WebViewDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  a: IHTMLElement2;
begin
  if url=openurl then
  begin
    coboxUrl.Text := url;
    completed := True;
    try
      a := (webView.Document as IHTMLDocument2).body as IHTMLElement2;
      if a=nil then
        exit;

      if a.scrollHeight > webView.Height then
      begin
        ScrollBarV.Max := a.scrollHeight-webView.Height;
        ScrollBarV.Enabled := IsHost;
      end
      else
        ScrollBarV.Enabled := False;

      if a.scrollWidth > webView.Width then
      begin
        ScrollBarH.Max := a.scrollWidth-webView.Width;
        ScrollBarH.Enabled := IsHost;
        ScrollBarH.Visible := True;
      end
      else begin
        ScrollBarH.Enabled := False;
        ScrollBarH.Visible := false;
      end;
    except
    end;
  end;
end;

procedure TCoBrowseFrom.SendBrowse;
begin
  sendBrowsecmd('open');
end;

procedure TCoBrowseFrom.sendBrowsecmd(cmd: string; const content: string);
var
  iq: TJabberIQ;
  closeiq: TXMLTag;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  taskguid: TGUID;
begin
  tmp_id := TJabberID.Create(toJid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '对方已经脱机，网页将被关闭。', ico_info);
      if cmd<>'close' then
        Close;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := toJid;
  tmp_id.Free;

  try
    if Cmd='close' then
    begin
      closeiq := TXMLTag.Create('iq');
      with closeiq do begin
        setAttribute('to', tmps);
        setAttribute('id', MainSession.generateID());
        setAttribute('type', 'set');
        with AddTag('query') do begin
          setAttribute('xmlns', XMLNS_AnyQBROWSEWEB);
          AddBasicTag('webid', GUIDToString(BrowsID));
          AddBasicTag('close', '');
        end;
      end;
      MainSession.SendTag(closeiq);
      exit;
    end;

    iq := TJabberIQ.Create(MainSession, MainSession.generateID, browseCallback, 30);
    with iq do begin
      Namespace := XMLNS_AnyQBROWSEWEB;
      iqType := 'set';
      toJid := tmps;
      qTag.AddBasicTag('webid', GUIDToString(BrowsID));
      qTag.AddBasicTag(cmd, content);
      Send;
    end;
  except
    ShowRiserWindow(nil, '共同浏览中出错，页面将被关闭。', ico_info);
    close;
  end;    {}
end;

procedure TCoBrowseFrom.BrowseCallback(event: string; tag: TXMLTag);
var
  errtag: TXMLTag;
begin
  if ((event = 'xml') or (event = 'cache')) then begin
    if (tag.GetAttribute('type') = 'error') then
    begin
      ShowRiserWindow(nil, '出现错误，页面将关闭', ico_info);
      close;
    end;

    if (tag.GetAttribute('type') = 'result') then
    begin
      //对方接受请求，进行处理
    end;
  end
  else
  begin
    //超时或者其他错误;
    ShowRiserWindow(nil, '对方没有响应，页面将关闭', ico_info);
    if csDestroying in ComponentState then
      exit;
    Close;
  end;
end;

procedure TCoBrowseFrom.go(url: string);
begin
  CanOpenNew := True;
  Completed := True;
  coboxUrl.Text := url;
  _DrawList.Clear;
  WebView.Navigate(url);
end;

{ TAnyQWebDraw }

constructor TAnyQWebDraw.Create;
begin
  PathList := TList.Create;
end;

destructor TAnyQWebDraw.Destroy;
begin
  PathList.Free;
  inherited;
end;

procedure TCoBrowseFrom.FormDestroy(Sender: TObject);
begin
  _DrawList.Free;
end;

procedure TCoBrowseFrom.webWndProc(var Message: TMessage);
var
  Dc: HDC;
  Rect: TRect;
  a: IHTMLElement2;
  x,y,ox,oy: Integer;
  sX,sY: Integer;
  Draw: TAnyQWebDraw;
  DrawStr: string;
  hP: HPEN;
  procedure Default;
  begin
    with Message do
      Result := CallWindowProc(oldweblong, webHandle, Msg, wParam, lParam);
  end;

  procedure DrawLine;
  var
    i, j : integer;
  begin
    a := (webView.Document as IHTMLDocument2).body as IHTMLElement2;
    ox := a.scrollLeft;
    oy := a.scrollTop;
    Dc := GetDC(webHandle);
    for i:= 0 to _DrawList.Count-1 do
    begin
      Draw := TAnyQWebDraw(_DrawList.Items[i]);
      if Draw.PathList.Count<=2 then
        Continue;
      hP := CreatePen(PS_SOLID, 4, ColorToRGB(Draw.Color));
      SelectObject(Dc,hp);
      j := 0;
      sx := Integer(Draw.PathList.Items[j]);
      inc(j);
      sy := Integer(Draw.PathList.Items[j]);
      inc(j);
      MoveToEx(Dc, sx-ox,sy-oy, nil);
      repeat
        sx := Integer(Draw.PathList.Items[j]);
        inc(j);
        sy := Integer(Draw.PathList.Items[j]);
        inc(j);
        lineto(DC, sx-ox,sy-oy);
      until j >= Draw.PathList.Count;
      DeleteObject(hp);
    end;
    ReleaseDC(webHandle, Dc);
  end;
begin
  case Message.Msg of
    WM_LBUTTONUP:
      begin
        if not IsHost then
          exit;
        if tbDraw.Down then
        begin
          Draw := TAnyQWebDraw(_DrawList.Items[_DrawList.Count-1]);
          DrawStr := DrawToStr(Draw);
          if DrawStr<>'' then
            sendBrowsecmd('draw', DrawStr)
          else
          begin
            _DrawList.Delete(_DrawList.Count-1);
          end;
          Message.Result := 0;
          exit;
        end;
      end;
    WM_LBUTTONDOWN:
      begin
        if not IsHost then
          exit;
        if tbDraw.Down then
        begin
          Draw := TAnyQWebDraw.Create;
          Draw.Color := cbColor.Selected;
          a := (webView.Document as IHTMLDocument2).body as IHTMLElement2;
          ox := a.scrollLeft;
          oy := a.scrollTop;
          X := Message.LParamLo;
          Y := Message.LParamHi;
          _DrawList.Add(Draw);
          Draw.PathList.Add(Pointer(x+ox));
          Draw.PathList.Add(Pointer(y+oy));
          Message.Result := 0;
          exit;
        end
      end;
    WM_MOUSEMOVE:
      begin
        if tbDraw.Down and ((Message.WParam and MK_LBUTTON)>0) then
        begin
          a := (webView.Document as IHTMLDocument2).body as IHTMLElement2;
          Draw := TAnyQWebDraw(_DrawList.Last);
          sx := Integer(Draw.PathList.Items[Draw.PathList.Count-2]);
          sy := Integer(Draw.PathList.Items[Draw.PathList.Count-1]);
          ox := a.scrollLeft;
          oy := a.scrollTop;
          X := Message.LParamLo;
          Y := Message.LParamHi;
          Draw.PathList.Add(Pointer(x+ox));
          Draw.PathList.Add(Pointer(y+oy));
          DC := GetDC(webHandle);
          hP := CreatePen(PS_SOLID, 4, ColorToRGB(Draw.Color));
          SelectObject(Dc,hp);
          MoveToEx(DC, sx-ox, sY-oy, nil);
          LineTo(DC, x, Y);
          DeleteObject(hp);
          ReleaseDC(webHandle, DC);
          Message.Result := 0;
          exit;
        end;
      end;
    WM_PAINT:
      begin
        Default;
        if _DrawList.Count>0 then
          DrawLine;
        exit;
      end;
  end;
  Default;
end;

procedure TCoBrowseFrom.WebViewNavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  a: IHTMLElement2;
begin
  if webHandle = INVALID_HANDLE_VALUE then
  begin
    webHandle := ChildWindowFromPoint(ChildWindowFromPoint(webView.Handle, point(0,0)), point(0,0));
    if webHandle=ChildWindowFromPoint(webView.Handle, point(0,0)) then
      webHandle := INVALID_HANDLE_VALUE;
    if webHandle<>INVALID_HANDLE_VALUE then
    begin
      oldweblong := Pointer(GetWindowLong(webHandle, GWL_WNDPROC));
      SetWindowLong(webHandle, GWL_WNDPROC, Longint(Classes.MakeObjectInstance(webWndProc)));
    end; {}
  end;  {}

  if not CanOpenNew then
    CanOpenNew := url=openurl;

  if not ScrollBarV.Visible then
  ScrollBarV.Visible := True;

  try
    a := (webView.Document as IHTMLDocument2).body as IHTMLElement2;
    if a=nil then
      exit;
    if a.scrollHeight > webView.Height then
    begin
      ScrollBarV.Max := a.scrollHeight-webView.Height;
      ScrollBarV.Enabled := IsHost;
    end
    else
      ScrollBarV.Enabled := False;


    if a.scrollWidth > webView.Width then
    begin
      ScrollBarH.Max := a.scrollWidth-webView.Width;
      ScrollBarH.Enabled := IsHost;
      ScrollBarH.Visible := True;
    end
    else begin
      ScrollBarH.Enabled := False;
      ScrollBarH.Visible := false;
    end;
  except
  end;
end;

procedure TCoBrowseFrom.tbClearClick(Sender: TObject);
var
  Rect: Trect;
begin
  _DrawList.Clear;
  Rect := webView.ClientRect;
  InvalidateRect(webHandle, @Rect ,true);
  if IsHost then
    sendBrowsecmd('clear');
end;

function TCoBrowseFrom.webViewGetHostInfo(
  var pInfo: TDOCHOSTUIINFO): HRESULT;
begin
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER or DOCHOSTUIFLAG_SCROLL_NO; 
end;

procedure TCoBrowseFrom.ScrollBarVChange(Sender: TObject);
Var
  x, y: integer;
begin
  X := 0;
  y := 0;
  if ScrollBarH.Visible and ScrollBarH.Enabled and (ScrollBarH.Position>=0) then
    x := ScrollBarH.Position;
  if ScrollBarV.Visible and ScrollBarV.Enabled and (ScrollBarV.Position>=0) then
    y := ScrollBarV.Position;
  try
    (webView.Document as IHTMLDocument2).parentWindow.scrollTo(x, y);
  except
  end;
  if IsHost then
    sendBrowsecmd('scroll',inttohex(x,8)+inttohex(y,8));
end;

procedure TCoBrowseFrom.ScrollBarHChange(Sender: TObject);
Var
  x, y: integer;
begin
  X := 0;
  y := 0;
  if ScrollBarH.Visible and ScrollBarH.Enabled and (ScrollBarH.Position>=0) then
    x := ScrollBarH.Position;
  if ScrollBarV.Visible and ScrollBarV.Enabled and (ScrollBarV.Position>=0) then
    y := ScrollBarV.Position;
  try
//    ((webView.Document as IHTMLDocument2).body as IHTMLElement2).scrollLeft := x;
    (webView.Document as IHTMLDocument2).parentWindow.scrollTo(x, y);
  except
  end;
  if IsHost then
    sendBrowsecmd('scroll',inttohex(x,8)+inttohex(y,8));
end;

procedure TCoBrowseFrom.doscroll(scrollstr: string);
var
  x,y: Integer;
begin
  try
    X := Strtoint('$'+Copy(scrollstr,1,8));
    Y := strtoint('$'+Copy(scrollstr,9,8));
    ScrollBarH.Position := X;
    ScrollBarV.Position := y;
  except
  end;
end;

function TCoBrowseFrom.webViewShowContextMenu(const dwID: Cardinal;
  const ppt: PPoint; const pcmdtReserved: IInterface;
  const pdispReserved: IDispatch): HRESULT;
begin
  Result := S_OK;
end;

procedure TCoBrowseFrom.tbrefreshClick(Sender: TObject);
begin
  webView.Refresh;
end;

procedure TCoBrowseFrom.tbStopClick(Sender: TObject);
begin
  WebView.Stop;
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.
