如何在 Delphi 中的 WebBrowser 组件上绘制内容

Question

是否可以在 WebBrowser 组件上绘制或放置一些东西来在其上绘制？
当我在 Web 浏览器上添加图像时，该图像始终位于 Web 浏览器下。 我需要它始终以相同的方式在不同的地图类型上绘制区域。 例如，我需要在谷歌地图上绘制相同的区域并打开街道地图......

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.