How to draw something on top of a WebBrowser component in Delphi

Question

Can I draw or place something on top of a WebBrowser component to draw it?
When I add an image to WebBrowser, that image is always under WebBrowser. I need this to draw an area on different types of maps always the same. For example, I need to draw the same area on Google Maps and open street maps ...

Answer 1

To do this, you should use the IHTMLPainter.Draw event method. The following code needs a TWebBrowser , where you should write an OnDocumentComplete event handler.

Note that this example has one big weakness, user input events, such as a mouse click, are active, because the only thing this example does is draw over an element. I played with this a bit, but without success. This may be a good topic for another question.

 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.