Come disegnare qualcosa sul componente WebBrowser in Delphi

Question

È possibile disegnare o mettere qualcosa sul componente WebBrowser per disegnare su di esso?
Quando aggiungo un'immagine a WebBrowser questa immagine è sempre sotto il browser web. Ho bisogno di questo per disegnare l'area su diversi tipi di mappe sempre nello stesso modo. Ad esempio, devo disegnare la stessa area su Google Maps e aprire le mappe stradali ...

Answer 1

Per questo scopo è necessario utilizzare il metodo di evento IHTMLPainter.Draw. Il codice seguente richiede un TWebBrowser in cui è necessario scrivere il gestore di eventi OnDocumentComplete.

Si noti che questo esempio ha una grande debolezza, gli eventi di input dell'utente come il clic del mouse sono attivi perché l'unica cosa che questo esempio fa è il dipinto sull'elemento. Ho giocato un po 'con questo, ma senza successo. Questo potrebbe essere un buon argomento per un'altra domanda.

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.