Comment puis-je éviter l'actualisation avec TWebBrowser?

Question

J'ai un composant TWebBrowser qui affiche une page Google Maps. Le problème est que lorsque l'utilisateur appuie sur F5, l'actualisation de la page et la recharge de la page. Cela provoque des variables javascript à réinitialiser et désynchroniser avec Delphi et une boîte de dialogue d'erreur de script apparaît, 'undefined' est null ou un objet.

Je souhaite arrêter l'actualisation de l'utilisateur.

J'ai essayé cet événement pour OnBeforeNavigate2:

procedure TNewOrganizationForm.mapAddressBeforeNavigate2(ASender: TObject; 
    const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, 
    Headers: OleVariant; var Cancel: WordBool); 
begin 
    inherited; 
    Cancel := Assigned(fMapEngine) and not fMapEngine.Loading; 
end; 

Mais quand je mets un point d'arrêt il est même pas appelé. Y a-t-il un autre moyen?

Answer 1

Ronald vous pouvez utiliser l'événement IHTMLDocument2.onkeydown pour intercepter et bloquer une clé.

Pour affecter un gestionnaire d'événements, vous devez d'abord créer un type de procédure en utilisant le paramètre IHTMLEventObj.

THTMLProcEvent = procedure(Sender: TObject; Event: IHTMLEventObj) of object; 

alors vous devez créer un descendant de la classe de InterfacedObject et IDispatch pour passer et traiter les événements.

vous pouvez enfin traiter la clé interceptées en cas onkeydown de cette manière

Var 
    HTMLDocument2 : IHTMLDocument2; 
begin 
    if Not Assigned(WebBrowser1.Document) then Exit; 
    HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2); 
    if HTMLDocument2.parentWindow.event.keyCode=VK_F5 then //compare the key 
    begin 
    HTMLDocument2.parentWindow.event.cancelBubble:=True; //cancel the key 
    HTMLDocument2.parentWindow.event.keyCode  :=0; 
    end; 
end; 

// vérifier le code source complet

unit Unit55; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, OleCtrls, SHDocVw, MSHTML; 

type 
    //Create the procedure type to assign the event 
    THTMLProcEvent = procedure(Sender: TObject; Event: IHTMLEventObj) of object; 

    //Create a new class for manage the event from the twebbrowser 
    THTMLEventLink = class(TInterfacedObject, IDispatch) 
    private 
    FOnEvent: THTMLProcEvent; 
    private 
    constructor Create(Handler: THTMLProcEvent); 
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall; 
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; 
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; 
     NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; 
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; 
     Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; 
    public 
    property OnEvent: THTMLProcEvent read FOnEvent write FOnEvent; 
    end; 

    TForm55 = class(TForm) 
    WebBrowser1: TWebBrowser; 
    procedure FormShow(Sender: TObject); 
    procedure WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    FOnKeyDownConnector: THTMLEventLink; //pointer to the event handler 
    procedure WebBrowser1OnKeyDown(Sender: TObject; EventObjIfc: IHTMLEventObj);//the event handler 
    public 
    { Public declarations } 
    end; 

var 
    Form55: TForm55; 

implementation 

{$R *.dfm} 


constructor THTMLEventLink.Create(Handler: THTMLProcEvent); 
begin 
    inherited Create; 
    _AddRef; 
    FOnEvent := Handler; 
end; 


function THTMLEventLink.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 


function THTMLEventLink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 


function THTMLEventLink.GetTypeInfoCount(out Count: Integer): HResult; 
begin 
    Result := E_NOTIMPL; 
end; 


function THTMLEventLink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; 
var 
    HTMLEventObjIfc: IHTMLEventObj; 
begin 
    Result := S_OK; 
    if Assigned(FOnEvent) then FOnEvent(Self, HTMLEventObjIfc); 
end; 



procedure TForm55.FormCreate(Sender: TObject); 
begin 
    FOnKeyDownConnector := THTMLEventLink.Create(WebBrowser1OnKeyDown); //assign the address of the event handler 
end; 


procedure TForm55.WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); 
var 
    HTMLDocument2  : IHTMLDocument2; 
begin 
    HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2); 
    HTMLDocument2.onkeydown := FOnKeyDownConnector as IDispatch; //assign the event handler 
end; 

procedure TForm55.WebBrowser1OnKeyDown(Sender: TObject; EventObjIfc: IHTMLEventObj); 
Var 
    HTMLDocument2 : IHTMLDocument2; 
begin 
    //finally do your stuff here, in this case we will intercept and block the F5 key. 
    if Not Assigned(WebBrowser1.Document) then Exit; 
    HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2); 
    if HTMLDocument2.parentWindow.event.keyCode=VK_F5 then 
    begin 
    HTMLDocument2.parentWindow.event.cancelBubble:=True; 
    HTMLDocument2.parentWindow.event.keyCode  :=0; 
    end; 
end; 



procedure TForm55.FormShow(Sender: TObject); 
begin 
WebBrowser1.Navigate('www.google.com'); 
end; 



end. 

Answer 2

Je n'ai pas trouvé un moyen facile de le faire. Je ne pouvais pas trouver d'événement ou quelque chose de similaire sur TWebBrowser, cela serait dissable rafraîchir. Peut-être que vous devriez vérifier TEmbededWB car il a plus d'événements et est plus capable que le TWebBrowser par défaut. Sinon, ils sont très similaires.

Mais j'ai trouvé un moyen d'empêcher l'actualisation. Maintenant, c'est drôle que même avec KeyPreview mis à "True" sur le formulaire principal, je ne pouvais pas recevoir les notifications clés. Il semble que TWebBrowser les mange en quelque sorte. Mais cela a fonctionné:

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    Application.OnMessage := OnAppMessage; 
end; 

procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean); 
begin 
    if Msg.message = WM_KEYDOWN then 
    if Msg.wParam = VK_F5 then 
     Handled := True; 
end; 

Pas la manière la plus élégante mais au moins cela fonctionne. Je n'ai pas encore trouvé de meilleure solution.