Cómo dibujar algo sobre el componente WebBrowser en Delphi

Question

¿Es posible dibujar o colocar algo sobre el componente WebBrowser para dibujar sobre él?
Cuando agrego una imagen en WebBrowser, esta imagen siempre está en WebBrowser. Necesito esto para dibujar el área sobre diferentes tipos de mapas siempre de la misma manera. Por ejemplo, necesito dibujar la misma área en Google Maps y abrir mapas de calles ...

Answer 1

Debe usar el método de evento IHTMLPainter.Draw para hacerlo. El siguiente código necesita un TWebBrowser donde debe escribir el controlador de eventos OnDocumentComplete.

Tenga en cuenta que este ejemplo tiene una gran debilidad, los eventos de entrada del usuario como el clic del mouse están activos porque lo único que este ejemplo hace es pintar sobre el elemento. He estado jugando con esto un poco, pero sin éxito. Este podría ser un buen tema para otra pregunta.

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.