Làm thế nào để vẽ một cái gì đó trên thành phần WebBrowser trong Delphi

Question

Có thể vẽ hoặc đặt một thứ gì đó lên thành phần WebBrowser để vẽ trên đó không?
Khi tôi thêm hình ảnh trên WebBrowser, hình ảnh này luôn nằm trong WebBrowser. Tôi cần điều này để vẽ khu vực trên các loại bản đồ khác nhau luôn theo cùng một cách. Ví dụ: tôi cần vẽ cùng một khu vực trên Google Maps và mở bản đồ đường phố ...

Answer 1

Bạn nên sử dụng phương thức sự kiện IHTMLPainter.Draw để thực hiện việc này. Đoạn mã sau cần số TWebBrowser nơi bạn phải viết trình xử lý sự kiện OnDocumentComplete. Lưu ý rằng ví dụ này có một điểm yếu lớn, các sự kiện nhập của người dùng như nhấp chuột đang hoạt động vì điều duy nhất mà ví dụ này làm là vẽ trên phần tử. Tôi đã chơi với điều này một chút, nhưng không thành công. Đây có thể là một chủ đề tốt cho một câu hỏi khác.

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.