在程序上放一个WebBrowser1
再做一个超酷的网页,test.htm
1．网页的按钮做或菜单做的好看点，并设置地址：
<area shape="rect" coords="24,166,142,201" href="button1_" alt="" >
２．WebBrowser1设置onBeforeNavigate2获得此地址，并做出反应．
If Pos('button1_', URL)>0 then
begin
{调用其它功能}
Cancel:=True;
end;
即可．
代码如下：Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
procedure WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant;
var Cancel: WordBool);
Procedure ApplicationEvents1Message(Var Msg:tagMSG;
Var Handled:Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure TForm1.ApplicationEvents1Message(Var Msg:TMsg;
Var Handled:Boolean);
begin
With Msgdo
If ((message=WM_RBUTTONDOWN)Or
(message=WM_RBUTTONDBLCLK))Or
(message=WM_CONTEXTMENU)Or
(Msg.message=WM_KEYDOWN)Or
((Msg.wParam>=113)And(Msg.wParam<=123)) then
Handled:=True;
end;
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant;
var Cancel: WordBool);
begin
If Pos('button1_', URL)>0 then
begin
ShowMessage('你选择了按钮一！');
Cancel:=True;
end;
If Pos('button2_', URL)>0 then
begin
ShowMessage('你选择了按钮二！');
Cancel:=True;
end;
If Pos('button3_', URL)>0 then
begin
ShowMessage('你选择了按钮三！');
Cancel:=True;
end;
If Pos('button4_', URL)>0 then
close;
If Pos('photo1_', URL)>0 then
begin
ShowMessage('你选择了图片一！');
Cancel:=True;
end;
If Pos('photo2_', URL)>0 then
begin
ShowMessage('你选择了图片二！');
Cancel:=True;
end;
If Pos('Email_', URL)>0 then
begin
ShowMessage('发邮件!');
Cancel:=True;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage:=ApplicationEvents1Message;
WebBrowser1.Navigate(ExtractFilePath(Application.ExeName)+'test.htm');
end;
end.
Unit1.dfm代码如下：
object Form1: TForm1
Left = 120
Top = 157
BorderStyle = bsDialog
Caption = #22270#24418#36719#20214#30028#38754
ClientHeight = 522
ClientWidth = 760
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object WebBrowser1: TWebBrowser
Left = 0
Top = 0
Width = 760
Height = 522
Align = alClient
TabOrder = 0
OnBeforeNavigate2 = WebBrowser1BeforeNavigate2
ControlData = {
4C0000008C4E0000F33500000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
test.htm代码如下：
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;
charset=gb2312">
<title>无标题文档</title>
</head>
<body scroll="no">
<img name="t" src="t.gif" width="750" height="495" border="0" usemap="#m_t" alt=""><map name="m_t">
<area shape="rect" coords="629,430,747,465" href="Email_" alt="" >
<area shape="rect" coords="465,243,608,362" href="photo2_" alt="" >
<area shape="rect" coords="243,235,383,368" href="photo1_" alt="" >
<area shape="rect" coords="20,323,138,358" href="button4_" alt="" >
<area shape="rect" coords="20,267,138,302" href="button3_" alt="" >
<area shape="rect" coords="24,217,142,252" href="button2_" alt="" >
<area shape="rect" coords="24,166,142,201" href="button1_" alt="" >
</map>
</body>
</html>
以下代码均已测过，可直接使用．
给分！结帖给分！
偶是奖金猎人，对给分很看重的，回答注重质量，
如果不给分，上了我的黑名单，下次就不帮你了。
