Как нарисовать что-то поверх компонента WebBrowser в Delphi - PullRequest
Новая
       22

Как нарисовать что-то поверх компонента WebBrowser в Delphi

6 голосов
/ 21 октября 2011

Можно ли нарисовать или поместить что-либо поверх компонента WebBrowser, чтобы нарисовать на нем?
Когда я добавляю изображение в WebBrowser, это изображение всегда находится в WebBrowser.Мне нужно это, чтобы рисовать области на разных типах карт всегда одинаково.Например, мне нужно нарисовать одну и ту же область на Картах Google и открыть карты улиц ...

1 Ответ

6 голосов
/ 23 октября 2011

Вы должны использовать IHTMLPainter.Draw метод события для этого.В следующем коде требуется TWebBrowser, где вы должны написать обработчик события OnDocumentComplete.

Обратите внимание, что в этом примере есть один большой недостаток - ввод пользователятакие события, как щелчок мышью, активны, потому что в этом примере выполняется только рисование поверх элемента.Я немного играл с этим, но безуспешно.Это может быть хорошей темой для другого вопроса. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, SHDocVw, MSHTML, OleCtrls;

type
  TElementBehavior = class(TInterfacedObject, IElementBehavior, IHTMLPainter)
  private
    FPaintSite: IHTMLPaintSite;
  public
    { IElementBehavior }
    function Init(const pBehaviorSite: IElementBehaviorSite): HRESULT; stdcall;
    function Notify(lEvent: Integer; var pVar: OleVariant): HRESULT; stdcall;
    function Detach: HRESULT; stdcall;
    { IHTMLPainter }
    function Draw(rcBounds: tagRECT; rcUpdate: tagRECT; lDrawFlags: Integer;
      hdc: hdc; pvDrawObject: Pointer): HRESULT; stdcall;
    function OnResize(size: tagSIZE): HRESULT; stdcall;
    function GetPainterInfo(out pInfo: _HTML_PAINTER_INFO): HRESULT; stdcall;
    function HitTestPoint(pt: tagPOINT; out pbHit: Integer; out plPartID: Integer): HRESULT; stdcall;
  end;

  TElementBehaviorFactory = class(TInterfacedObject, IElementBehaviorFactory)
  public
    function FindBehavior(const bstrBehavior: WideString;
      const bstrBehaviorUrl: WideString; const pSite: IElementBehaviorSite;
      out ppBehavior: IElementBehavior): HRESULT; stdcall;
  end;

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Image: TBitmap;
  Behavior: TElementBehavior;
  Factory: TElementBehaviorFactory;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image := TBitmap.Create;
  Image.LoadFromFile('c:\yourpicture.bmp');
  WebBrowser1.Navigate('maps.google.com');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Behavior := nil;
  Factory := nil;
  Image.Free;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  HTMLElement: IHTMLElement2;
  FactoryVariant: OleVariant;
begin
  HTMLElement := (WebBrowser1.Document as IHTMLDocument3).getElementById('map') as IHTMLElement2;

  if Assigned(HTMLElement) then
  begin
    Behavior := TElementBehavior.Create;
    Factory := TElementBehaviorFactory.Create;
    FactoryVariant := IElementBehaviorFactory(Factory);
    HTMLElement.addBehavior('', FactoryVariant);
  end;
end;

function TElementBehaviorFactory.FindBehavior(const bstrBehavior,
  bstrBehaviorUrl: WideString; const pSite: IElementBehaviorSite;
  out ppBehavior: IElementBehavior): HRESULT;
begin
  ppBehavior := Behavior;
  Result := S_OK;
end;

function TElementBehavior.Draw(rcBounds: tagRECT; rcUpdate: tagRECT; lDrawFlags: Integer;
  hdc: hdc; pvDrawObject: Pointer): HRESULT;
begin
  StretchBlt(
    hdc,
    rcBounds.Left,
    rcBounds.Top,
    rcBounds.Right - rcBounds.Left,
    rcBounds.Bottom - rcBounds.Top,
    Image.Canvas.Handle,
    0,
    0,
    Image.Canvas.ClipRect.Right - Image.Canvas.ClipRect.Left,
    Image.Canvas.ClipRect.Bottom - Image.Canvas.ClipRect.Top,
    SRCCOPY);
  Result := S_OK; 
end;

function TElementBehavior.GetPainterInfo(out pInfo: _HTML_PAINTER_INFO): HRESULT;
begin
  pInfo.lFlags := HTMLPAINTER_OPAQUE;
  pInfo.lZOrder := HTMLPAINT_ZORDER_WINDOW_TOP;
  FillChar(pInfo.rcExpand, SizeOf(TRect), 0);
  Result := S_OK;
end;

function TElementBehavior.HitTestPoint(pt: tagPOINT; out pbHit,
  plPartID: Integer): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TElementBehavior.OnResize(size: tagSIZE): HRESULT;
begin
  Result := S_OK;
end;

function TElementBehavior.Detach: HRESULT;
begin
  if Assigned(FPaintSite) then
    FPaintSite.InvalidateRect(nil);
  Result := S_OK;
end;

function TElementBehavior.Init(
  const pBehaviorSite: IElementBehaviorSite): HRESULT;
begin
  Result := pBehaviorSite.QueryInterface(IHTMLPaintSite, FPaintSite);
  if Assigned(FPaintSite) then
    FPaintSite.InvalidateRect(nil);
end;

function TElementBehavior.Notify(lEvent: Integer;
  var pVar: OleVariant): HRESULT;
begin
  Result := E_NOTIMPL;
end;

end.
...