如何通過Delphi中的WebBrowser組件繪製某些東西

Question

是否可以在WebBrowser組件上繪製或放置某些東西來繪製它？
當我在WebBrowser上添加圖像時，此圖像始終位於WebBrowser下。 我需要這個以相同的方式在不同的地圖類型上繪製區域。 例如，我需要在Google地圖上繪製相同的區域並打開街道地圖...

Answer 1

您應該使用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.