多个WebBrowser的按键响应
使用场景: 多个WebBrowser同时使用, 分别响应回车, 右键菜单等事件
已在Delphi xe测试通过
//单元文件
[delphi]
unit Unit11;
inte易做图ce
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ComCtrls, activeX;
type
TForm11 = class(TForm)
pgc1: TPageControl;
ts1: TTabSheet;
ts2: TTabSheet;
wb1: TWebBrowser;
wb2: TWebBrowser;
procedure FormCreate(Sender: TObject);
procedure pgc1Change(Sender: TObject);
private
{ Private declarations }
//当前激活的WebBrowser控件
{当激活的WebBrowser控件变化时更新该字段的值, 在IEMessageHandler中使用}
FCurrBW : TWebBrowser;
procedure IEMessageHandler(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;
var
Form11: TForm11;
implementation
{$R *.dfm}
procedure TForm11.IEMessageHandler(var Msg: TMsg; var Handled: Boolean);
const
StdKeys = [VK_TAB, VK_RETURN]; { 标准键 }
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { 扩展键 }
fExtended = $01000000; { 扩展键标志 }
begin
Handled := False;
if (FCurrBW = nil) then
begin
Handled := False;
Exit;
end;
with Msg do
begin
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or
(wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
begin
try
with FCurrBW.Application as IOleInPlaceActiveObject do
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
except
end;
end;
end;
end;
procedure TForm11.pgc1Change(Sender: TObject);
begin
case pgc1.ActivePageIndex of
0 : FCurrBW := wb1;
1 : FCurrBW := wb2;
end;
end;
procedure TForm11.FormCreate(Sender: TObject);
begin
FCurrBW := wb1;
Application.OnMessage := IEMessageHandler;
wb1.Navigate('http://bbs.csdn.net/topics/390341172?page=1#post-393434373');
wb2.Navigate('http://bbs.csdn.net/topics/390341172?page=1#post-393434373');
end;
end.
//窗体文件
[delphi]
object Form11: TForm11
Left = 0
Top = 0
Caption = 'Form11'
ClientHeight = 610
ClientWidth = 788
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 106
TextHeight = 14
object pgc1: TPageControl
Left = 0
Top = 0
Width = 788
Height = 610
ActivePage = ts1
Align = alClient
TabOrder = 0
OnChange = pgc1Change
object ts1: TTabSheet
Caption = 'ts1'
object wb1: TWebBrowser
Left = 0
Top = 0
Width = 780
Height = 581
Align = alClient
TabOrder = 0
ExplicitLeft = 160
ExplicitTop = 64
ExplicitWidth = 300
ExplicitHeight = 150
ControlData = {
4C00000003490000623600000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
object ts2: TTabSheet
Caption = 'ts2'
ImageIndex = 1
object wb2: TWebBrowser
Left = 0
Top = 0
Width = 780
Height = 581
Align = alClient
TabOrder = 0
ExplicitLeft = 160
ExplicitTop = 64
