Search code examples
delphidelphi-xe7twebbrowser

Why does arrow key navigation not work in TWebBrowser?


Here is a simple program that hosts a TWebBrowser control in a VCL application:

Unit1.pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Browser: TWebBrowser;
begin
  Browser := TWebBrowser.Create(Self);
  TOleControl(Browser).Parent := Self;
  Browser.Align := alClient;
  Browser.Navigate('http://www.bbc.co.uk/');
end;

end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 587
  ClientWidth = 928
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
end

When I run the program, I would like to be able to scroll through the page using the arrow keys, up/down/left/right. However, these keys have no effect. I can use page up and page down, but not up/down/left/right.

I re-created the equivalent application in a .net WinForms application using the WebBrowser control and the behaviour was identical. That would seem to suggest an issue with the underlying control.

Can I do anything to get these keys to work? Or is this just a lost cause?


Solution

  • I believe that the form is interpreting these keys as dialog navigation keys. So I changed the control's response to the WM_GETDLGCODE message to request that the control handles these keys:

    type
      TWebBrowser = class(SHDocVw.TWebBrowser)
      protected
        procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
      end;
    
    procedure TWebBrowser.WMGetDlgCode(var Msg: TWMGetDlgCode);
    begin
      inherited;
      Msg.Result := Msg.Result or DLGC_WANTARROWS;
    end;
    

    This appears to resolve the issue.