Delphi WebBrowser控件的使用（大全 good）
Delphi WebBrowser控件的使用
WebBrowser控件属性：
1、Application
如果该对象有效，则返回掌管WebBrowser控件的应用程序实现的自动化对象(IDispatch)。如果在宿主对象中自动化对象无效，程序将返回WebBrowser控件的自动化对象
2、Parent
返回WebBrowser控件的父自动化对象，通常是一个容器，例如是宿主或IE窗口
3、Containe
返回WebBrowser控件容器的自动化对象。通常该值与Parent属性返回的值相同
4、Document
为活动的文档返回自动化对象。如果HTML当前正被显示在WebBrowser中，则Document属性提供对DHTML Object Model的访问途径
5、TopLevelContainer
返回一个Boolean值，表明IE是否是WebBrowser控件顶层容器，是就返回true
6、Type
返回已被WebBrowser控件加载的对象的类型。例如：如果加载.doc文件，就会返回Microsoft Word Document
7、Left
返回或设置WebBrowser控件窗口的内部左边与容器窗口左边的距离
8、Top
返回或设置WebBrowser控件窗口的内部左边与容器窗口顶边的距离
9、Width
返回或设置WebBrowser窗口的宽度，以像素为单位
10、Height
返回或设置WebBrowser窗口的高度，以像素为单位
11、LocationName
返回一个字符串，该字符串包含着WebBrowser当前显示的资源的名称，如果资源是网页就是网页的标题；如果是文件或文件夹 ，就是文件或文件夹的名称
12、LocationURL
返回WebBrowser当前正在显示的资源的URL
13、Busy
返回一个Boolean值，说明WebBrowser当前是否正在加载URL，如果返回true就可以使用stop方法来撤销正在执行的访问操作
WebBrowser控件的事件:
1、BeforeNavigate2 导航发生前激发，刷新时不激发
2、CommandStateChange 当命令的激活状态改变时激发。它表明何时激活或关闭Back和Forward菜单项或按钮
3、DocumentComplete 当整个文档完成是激发，刷新页面不激发
4、DownloadBegin 当某项下载操作已经开始后激发，刷新也可激发此事件
5、DownloadComplete 当某项下载操作已经完成后激发，刷新也可激发此事件
6、 NavigateComplete2 导航完成后激发，刷新时不激发 NewWindow2 在创建新窗口以前激发
7、OnFullScreen 当FullScreen属性改变时激发。该事件采用VARIENT_BOOL的一个输入参数来指示IE是全屏显示方式(VARIENT_TRUE)还是普通显 示方式(VARIENT_FALSE)
8、OnMenuBar 改变MenuBar的属性时激发，标示参数是VARIENT_BOOL类型的。VARIANT_TRUE是可见，VARIANT_ FALSE是隐藏
9、OnQuit 无论是用户关闭浏览器还是开发者调用Quit方法，当IE退出时就会激发
10、 OnStatusBar 与OnMenuBar调用方法相同，标示状态栏是否可见。
11、 OnToolBar 调用方法同上，标示工具栏是否可见。
12、 OnVisible 控制窗口的可见或隐藏，也使用一个VARIENT_BOOL类型的参数
13、StatusTextChange 如果要改变状态栏中的文字，这个事件就会被激发，但它并不理会程序是否有状态栏
14、TitleChange 网页标题有效或改变时激发
例子程序
1、WebBrowser1.OleObject.document.all.item('btnName').click;//根据页面中按钮的名称执行其点击事件
2、WebBrowser1.OleObject.document.getElementByID('btnID').click;//根据按钮ID点击
3、WebBrowser1.OleObject.document.getElementsByTagName('input').item(0).click;//根据按钮索引点击
4、WebBrowser1.OleObject.document.all.item('userName').value:=userName;//修改文本框信息，也可用ID，同上
5、ShellExecute(0,'open','www.baidu.com',nil,nil,SW_SHOW);//为浏览器打开一个网页
WebBrowser控件的函数：
1、GoBack 相当于IE的”后退”按钮，使你在当前历史列表中后退一项
2、GoForward 相当于IE的”前进”按钮，使你在当前历史列表中前进一项
3、 GoHome 相当于IE的”主页”按钮，连接用户默认的主页
4、GoSearch 相当于IE的”搜索”按钮，连接用户默认的搜索页面
5、 Navigate 连接到指定的URL
6、Refresh 刷新当前页面
7、Refresh2 同上，只是可以指定刷新级别，所指定的刷新级别的值来自RefreshConstants枚举表，该表定义在ExDisp.h中，可以指定的不同值 如下： REFRESH_NORMAL 执行简单的刷新，不将HTTP pragma: no-cache头发送给服务器 REFRESH_IFEXPIRED 只有在网页过期后才进行简单的刷新 REFRESH_CONTINUE 仅作内部使用 REFRESH_COMPLETELY 将包含pragma: no-cache头的请求发送到服务器
初始化和终止化 这几句话放在主窗口所有语句之后，“end.”之前(需引用ActiveX单元)。
Initialization
OleInitialize(nil);
Finalization
try
OleUninitialize;
except
end;
TWebBrowser浏览相关
Webbrower的显示和隐藏
WebBrowser1.Visible:=False;//这句是没有效果的
TWinControl(WebBrowser1).Visible:=False;
OnCommandStateChange事件
当执行TWebBrowser组件的某个方法的功能改变时被触发，其状态取值决定于执行Web浏览器中某个方法的功能。
property OnCommandStateChange: TWebBrowserCommandStateChange;
type TWebBrowserCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;
Sender：指出其功能已变化的Web浏览器组件。
Command：指出功能变化的调用方法，参数取值如表所示。
| 常量 |
值 |
说明 |
| CSC_UPDATECOMMANDS |
−1 |
不被其他常量包含的任何变化，应用程序必须检查Web浏览器的该属性以更新控制， 例如，事件处理程序可能在更新Stop按钮时检查Busy属性 |
| CSC_NAVIGATEFORWARD |
1 |
历史列表改变GoForward方法导航到一个新的URL的功能，Enable参数指定GoForward方法现在是否导航到一个新的URL |
| CSC_NAVIGATEBACK |
2 |
历史列表改变GoBack方法导航到一个新的URL的功能，Enable参数指定GoBack方法现在是否导航到一个新的URL |
Enable：指定CSC_NAVIGATEFORWARD或CSC_NAVIGATEBACK命令是否可用，其值为True时，可用；否则不可用。
示例：
OnCommandStateChange事件提供了一个命令状态改变后的处理功能，通过该事件能够判断执行某个命令后的当前浏览器状态，例如控制“后退”、“前进”或“停止”按钮是否可用，代码如下：
procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;Command: Integer; Enable: WordBool);
Var bRtn:Boolean;
begin
case Command of
CSC_NAVIGATEBACK: ToolButton_Back.Enabled := Enable; //“后退”按钮
CSC_NAVIGATEFORWARD: ToolButton_Forward.Enabled := Enable; //“前进”按钮
CSC_UPDATECOMMANDS: ToolButton_Stop.Enabled := TWebBrowser(ASender).Busy; //“停止”按钮
end;
end;
使用进度条查看浏览器状态
procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
begin
ProgressBar1.Max:=ProgressMax;
if Progress = -1then
//ProgressBar1.Visible:=false
else
begin
ProgressBar1.Position := Progress;
ProgressBar1.Visible := True;
end;
if ProgressBar1.Position = ProgressMax then
//ProgressBar1.Visible:=False;
end;
1、去掉TWebBrowser的滚动条
方法1
uses MSHTML_TLB,MSHTML;
IHTMLBodyElementDisp(IHTMLDocument2(WebBrowser1.document).body).scroll:= 'no';
方法2
WebBrowser1.oleobject.Document.body.style.overflow:='hidden';
2、滚屏
uses MSHTML;
var
a: IHTMLDocument2;
x,y:Integer;
begin
y:=y+20; //加减进行上下滚动
a :=WebBrowser1.Document as IHTMLDocument2;
a.Get_ParentWindow.Scroll(x,y);
end;
3、去边框 边框去掉后 Webbrowser编辑时使用Enter换行无效 但可以使用Shift+Enter换行 Xe2有这个问题XE4正常
margin
应该有上下左右的
WebBrowser1.OleObject.Document.Body.style.border :='none';
WebBrowser1.OleObject.Document.Body.Style.margin := '0px';
4、禁止提示脚步错误
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;const pDisp: IDispatch;var URL: OleVariant);
begin
WebBrowser1.Silent := True;
end;
5、禁止弹出窗口
procedureTForm1.WebBrowser1NewWindow2(ASender: TObject;var ppDisp: IDispatch; varCancel: WordBool);
begin
Cancel := True;
end;
6、屏蔽右键菜单 先要添加ApplicationEvents1,指定其Message事件
//ApplicationEvents1.Event.OnMessage
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
with Msg do
begin
if not IsChild(WebBrowser1.Handle, hWnd) then
Exit;
Handled := (message = WM_RBUTTONDOWN) or (message= WM_RBUTTONUP) or (message= WM_CONTEXTMENU);
end;
end;
屏蔽右键菜单
//Here's the code to disable the context menu (the one a user gets when it right-clicks inside a TWebBrowser) for TWebBrowser in a Delphi application:
function MouseProc(nCode: Integer; wParam, lParam: Longint): LongInt; stdcall;
var
classbuf: array[0..255]of Char;
const
ie = 'Internet Explorer_Server';
begin
case nCode < 0 of
True:
Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
False:
case wParam of
WM_RBUTTONDOWN, WM_RBUTTONUP:
begin
GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, classbuf, SizeOf(classbuf)) ;
if lstrcmp(@classbuf[0], @ie[1])= 0 then
Result := HC_SKIP
else
Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
end
else
begin
Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
end;
end; //case wParam
end; //case nCode
end; (*MouseProc*)
//Form OnCreate
procedure TWebBrowserForm.FormCreate(Sender: TObject) ;
begin
MouseHook := SetWindowsHookEx(WH_MOUSE, MouseProc,0, GetCurrentThreadId()) ;
end;
//Form OnDestroy
procedure TWebBrowserForm.FormDestroy(Sender: TObject) ;
begin
if MouseHook <> 0 then UnHookWindowsHookEx(MouseHook) ;
end;
If you want to find more about Windows hooks, read the :An introduction to hook procedures
7、替换右键菜单
aaaa
7、通过IUniformResourceLocator接口建立Internet快捷方式
aaaa
8、设置焦点 (当Webbrowser处于编辑模式)
TWebBrowser非常特殊，它从TWinControl继承来的SetFocus方法并不能使得它所包含的文档获得焦点
//方法1
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Form1.WebBrowser1.Document <> nil then
with WebBrowser1.Application as IOleobjectdo
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1,0, Handle, GetClientRect());
end;
//方法2 Form1OnCreate事件无效
if WebBrowser1.Document <> nil then
IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).Focus();
9、缩放网页
Ctrl+中键↑ 放大
Ctrl+中键↓ 缩小
const
OLECMDID_OPTICAL_ZOOM = 63;
var
ZoomIn: OleVariant;
begin
ZoomIn := 10;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, ZoomIn);
end;
10、读取当前页面字体大小
类似“字体”菜单上的从“最大”到“最小”五项（对应整数0～4，Largest等假设为五个菜单项的名字，Tag 属性分别设为0～4）。
//读取当前页面字体大小
var
t: OleVariant;
Begin
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,EmptyParam,t);
case t of
4: Caption :='最大';
3: Caption :='较大';
2: Caption :='中';
1: Caption :='较小';
0: Caption :='最小';
end;
end;
//设置页面字体大小 这句代码Delphi7不能编译通过 Delphi Xe2可以运行
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,3);
11、添加到收藏夹 参考MFC的
const
CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';
procedure AddFavorite(Webbrowser:TWebBrowser);
var
ShellUIHelper: ISHellUIHelper;
url, title: Olevariant;
begin
Title := Webbrowser.LocationName;
Url := Webbrowser.LocationUrl;
if Url <>'' then
begin
ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
ShellUIHelper.AddFavorite(url, title);
end;
end;
整理收藏夹
var p:procedure(Handle: THandle; Path: PChar); stdcall;
procedure OrganizeFavorite();
var
H: HWnd;
begin
H := LoadLibrary(PChar('shdocvw.dll'));
if H <> 0 then
begin
p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle, PChar(''));
end;
FreeLibrary(h);
end;
11、 Internet 选项
uses ActiveX;
const
CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
// HTMLID_FIND = 1; //查找对话框
// HTMLID_VIEWSOURCE= 2; //查看源代码
// HTMLID_OPTIONS =3; //Internet选项
procedure WB_ShellIEOptions(WebBrowser: TWebbrowser);
var
CmdTarget : IOleCommandTarget;
vaIn, vaOut: OleVariant;
PtrGUID: PGUID;
begin
New(PtrGUID) ;
PtrGUID^ := CGID_WebBrowser;
if WebBrowser.Document <> nil then
try
WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget) ;
if CmdTarget <> nil then
try
CmdTarget.Exec(PtrGUID, 3, 0, vaIn, vaOut) ;
finally
CmdTarget._Release;
end;
except
end;
Dispose(PtrGUID) ;
end;
11、获取网页源码相关
1
2
3
Memo1.Text := WebBrowser1.OleObject.document.body.outerHTML;//body内的所有代码, 包含body标签
Memo1.Text := WebBrowser1.OleObject.document.documentElement.innerHTML;//html内的所有代码
Memo1.Text := WebBrowser1.OleObject.document.body.innerHTML;//body内的所有代码
11、 获取网页源文件的代码 网页右键 查看源文件 f1dfb8ff-ddb6-4ff5-8c99-4044bff87a12_0.htm - 记事本
procedure GetHtmlSourceCode(const RichEdit:TRichEdit);
var
ms: TMemoryStream;
begin
if not Assigned(Form1.WebBrowser1.Document) then Exit;
ms := TMemoryStream.Create;
(Form1.WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(ms), True);
ms.Position := 0;
RichEdit.Lines.LoadFromStream(ms, TEncoding.UTF8);
// Memo1.Lines.LoadFromStream(ms, TEncoding.Default); {GB2312 等双字节}
ms.Free;
end;
11、 获取网页源文件的代码 出来的结果乱码 unicode?
function GetHtml(const WebBrowser:TWebBrowser): string;
const
BufSize = $10000;
var
Size: Int64;
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;
OleCheck(WebBrowser.Document.QueryInterface
(IPersistStreamInit, psi));
try
OleCheck(psi.GetSizeMax(Size));
hHTMLText := GlobalAlloc(GPTR, BufSize);
if 0 = hHTMLText then RaiseLastWin32Error;
OleCheck(CreateStreamOnHGlobal(hHTMLText,True, Stream));
try
OleCheck(psi.Save(Stream, False));
Size := StrLen(PChar(hHTMLText));
SetLength(Result, Size);
CopyMemory(PChar(Result), Pointer(hHTMLText), Size);
finally
Stream := nil;
end;
finally
psi := nil;
end;
end;
11、 用记事本查看源代码
uses ActiveX;
const
CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
//HTMLID_FIND = 1; //查找对话框
//HTMLID_VIEWSOURCE= 2; //查看源代码
//HTMLID_OPTIONS =3; //Internet选项
procedure WB_ViewSource(WebBrowser: TWebbrowser);
var
CmdTarget : IOleCommandTarget;
vaIn, vaOut: OleVariant;
PtrGUID: PGUID;
begin
New(PtrGUID) ;
PtrGUID^ := CGID_WebBrowser;
if WebBrowser.Document <> nil then
try
WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget) ;
if CmdTarget <> nil then
try
CmdTarget.Exec(PtrGUID, 2, 0, vaIn, vaOut) ;
finally
CmdTarget._Release;
end;
except
end;
Dispose(PtrGUID) ;
end;
__、设置编码
procedure Set_charset(const p: WideString); safecall;
function Get_charset: WideString; safecall;
p的编码列表有哪些
//设置编码
procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet:String);
var
RefreshLevel: OleVariant;
Begin
IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);
RefreshLevel :=7;//这个7应该从注册表来，帮助有Bug。
AWebBrowser.Refresh2(RefreshLevel);
End;
//获取当前页面编码
Caption:=IHTMLDocument2(Webbrowser1.Document).Get_charset;
Cookies
var
doc: IHTMLDocument2;//定义变量
begin
Doc:=WebBrowser1.Document as IHTMLDocument2;
Doc.cookie:=redt_ViewSource.text;//把edit2中修改好的cookie重新赋值给doc
WebBrowser1.Refresh;//刷新页面,修改cookie
end;
11、执行网页源代码成网页
procedure ExecHTML(WebBrowser:TWebBrowser;HtmlCode:string);
var
StringStream:TStringStream;
begin
StringStream := TStringStream.Create(HtmlCode);
//WebBrowser.Navigate('about:blank');
try
StringStream.Position := 0;
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(StringStream));
finally
StringStream.Free;
end;
end;
我现在发现如果webbrowser内容比较少 就正常 如果内容多 右边有滚动条 这时候进来 点击滚动条
就会报“Floating point division by zero ” 这个错误 而且报完 界面被强制关闭掉 不知道阁下有没遇到这个问题 这里我代码中没有任何除法操作 只要webbrowser内容多 有滚动条 点击滚动条 就会这样
使用Delphi XE4 就没有这个问题
11、 加载HTML 将HTML代码转换成网页
procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode:string) ;
var
sl: TStringList;
ms: TMemoryStream;
begin
WebBrowser.Navigate('about:blank') ;
while WebBrowser.ReadyState< READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document)then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
HTMLCode:=''+HTMLCode;
sl.Text := HTMLCode;
sl.SaveToStream(ms) ;
ms.Seek(0, 0) ;
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
end;
11、 加载HTML成WEB
webbrowser.OleObject.Document.Writeln('HTML CODE');
webbrowser.Refresh;
11、QueryStatusWB
function QueryStatusWB(cmdID: OLECMDID): OLECMDF;
| cmdID列表 |
值 |
描述 |
| OLECMDF_SUPPORTED |
1 |
Web浏览器支持这个命令（但是该命令可能未被使用） |
| OLECMDF_ENABLED |
2 |
该命令当前是使用的 |
| OLECMDF_LATCHED |
4 |
该命令是一个打开/关闭开关，当前处于打开的状态 |
| OLECMDF_NINCHED |
8 |
当前尚未使用该值 |
| OLECMDF_INVISIBLE |
16 |
当前尚未使用该值 |
确定可以使用ExecWB方法执行的命令，即Web浏览器支持的命令信息，该方法使用IOleCommandTarget接口的QueryStatus方法来得到命令状态的信息。
//QueryStatusWB
procedure TForm1.Button1Click(Sender: TObject);
var
bEnable,bSupport:Boolean;
begin
bEnable:= WebBrowser1.QueryStatusWB(OLECMDID_PASTE)=OLECMDF_ENABLED;
bSupport:=WebBrowser1.QueryStatusWB(OLECMDID_PASTE)=OLECMDF_SUPPORTED;
if (bEnable or bSupport) then
WebBrowser1.ExecWB(OLECMDID_COPY,1);
end;
//QueryCommandEnabled
if (Webbrowser1.Document as IHTMLDocument2).QueryCommandEnabled('Copy')then
(Webbrowser1.Document as IHTMLDocument2).ExecCommand('Copy',false,'');
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT);overload;
cmdID参数列表
//文件
///新建 WebBrowser1.ExecWB(OLECMDID_NEW,1); //尚未实现
///打开 WebBrowser1.ExecWB(OLECMDID_OPEN,1);
///保存 WebBrowser1.ExecWB(OLECMDID_SAVE,1); //无保存网页的能力
///另存 WebBrowser1.ExecWB(OLECMDID_SAVEAS,1);//网页，仅 HTML (*.htm;*.html)
///-
///打印 WebBrowser1.ExecWB(OLECMDID_PRINT,1);
///打印预览 WebBrowser1.ExecWB(OLECMDID_PRINTPREVIEW,1);
///页面设置 WebBrowser1.ExecWB(OLECMDID_PAGESETUP,1);
///-
///属性 WebBrowser1.ExecWB(OLECMDID_PROPERTIES,1);
///编辑
///撤销 WebBrowser1.ExecWB(OLECMDID_REDO ,1);
///重做 WebBrowser1.ExecWB(OLECMDID_UNDO ,1);
///-
///复制 WebBrowser1.ExecWB(OLECMDID_COPY,1);
///剪切 WebBrowser1.ExecWB(OLECMDID_PASTE,1);
///粘贴 WebBrowser1.ExecWB(OLECMDID_CUT ,1);
///删除 WebBrowser1.ExecWB(OLECMDID_DELETE,1);
///-
///全选 WebBrowser1.ExecWB(OLECMDID_SELECTALL,1);
///不选 WebBrowser1.ExecWB(OLECMDID_CLEARSELECTION,1);
///查找/替换
///查找对话框 WebBrowser1.ExecWB(OLECMDID_FIND,1);
__、替换对话框
__、剪切板
uses Clipbrd;
procedure TForm1.ToolButton1Click(Sender: TObject);
var
i: integer;
Buffer: PChar;
s: string;
begin
Memo1.Lines.Clear;
with TClipboard.Create do
begin
GetMem(Buffer, 20);
for i:=0to FormatCount - 1 do
begin
GetClipboardFormatName(Formats[i], Buffer, 20);
s := StrPas(Buffer);
Memo1.Lines.Add(Format('%s:%d', [s, Formats[i]]));
end;
FreeMem(Buffer);
Free;
end;
end;
__、保存文档为 .HTML
The TWebBrowser component (located on the "Internet" page of the Component Palette) provides access to the Web browser functionality from your Delphi applications. In general, you'll want to enable saving of a web page displayed inside a WebBrowser as a HTML file to a disk.
Saving a web page as a raw HTML
If you only want to save a web page as a raw HTML you would select "Web Page, HTML only (*.htm, *.html)". It will simply save the current page's source HTML to your drive intact. This action will NOT save the graphics from the page or any other files used within the page, which means that if you loaded the file back from the local disk, you would see broken image links.
uses ActiveX;
procedure WB_SaveAs_HTML(WB : TWebBrowser;const FileName : string) ;
var
PersistStream: IPersistStreamInit;
Stream: IStream;
FileStream: TFileStream;
begin
if not Assigned(WB.Document) then
begin
ShowMessage('Document not loaded!') ;
Exit;
end;
PersistStream := WB.Document as IPersistStreamInit;
FileStream := TFileStream.Create(FileName, fmCreate) ;
try
Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
if Failed(PersistStream.Save(Stream, True))then ShowMessage('SaveAs HTML fail!') ;
finally
FileStream.Free;
end;
end; (* WB_SaveAs_HTML *)
Usage sample:
//first navigate
WebBrowser1.Navigate('about:blank') ;
//then save
WB_SaveAs_HTML(WebBrowser1,'c:\WebBrowser1.html') ;
__、
__、保存文档为 .mht
uses CDO_TLB, ADODB_TLB;
procedure WB_SaveAs_MHT(WB: TWebBrowser; FileName: TFileName) ;
var
Msg: IMessage;
Conf: IConfiguration;
Stream: _Stream;
URL : widestring;
begin
if not Assigned(WB.Document) then Exit;
URL := WB.LocationURL;
Msg := CoMessage.Create;
Conf := CoConfiguration.Create;
try
Msg.Configuration := Conf;
Msg.CreateMHTMLBody(URL, cdoSuppressAll, '','') ;
Stream := Msg.GetStream;
Stream.SaveToFile(FileName, adSaveCreateOverWrite) ;
finally
Msg := nil;
Conf := nil;
Stream := nil;
end;
end; (* WB_SaveAs_MHT *)
Sample usage:
//first navigate
WebBrowser1.Navigate('http://delphi.about.com') ;
//then save
WB_SaveAs_MHT(WebBrowser1,'c:\WebBrowser1.mht') ;
__、
__、粘贴位图选择粘贴
粘贴 HTML
粘贴纯文本
粘贴Unicode文字
粘贴RTF
__、Ctrl+V粘贴位图
__、查找突出显示匹配项
__、查找突出显示匹配项苗红
__、查找对话框
uses ActiveX;
const
CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
// HTMLID_FIND = 1; //查找对话框
// HTMLID_VIEWSOURCE= 2; //查看源代码
// HTMLID_OPTIONS =3; //Internet选项
procedure WB_FindDialog(WebBrowser: TWebbrowser);
var
CmdTarget : IOleCommandTarget;
vaIn, vaOut: OleVariant;
PtrGUID: PGUID;
begin
New(PtrGUID) ;
PtrGUID^ := CGID_WebBrowser;
if WebBrowser.Document <> nil then
try
WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget) ;
if CmdTarget <> nil then
try
CmdTarget.Exec(PtrGUID, 1, 0, vaIn, vaOut) ;
finally
CmdTarget._Release;
end;
except
end;
Dispose(PtrGUID) ;
end;
function execCommand(const cmdID: WideString; showUI: WordBool; value: OleVariant): WordBool; safecall;
cmdID参数列表
uses Mshtml;
///网页查看模式
(WebBrowser1.Document as IHTMLDocument2).designMode := 'on';
(WebBrowser1.Document as IHTMLDocument2).execCommand('EditMode',False,1);
///网页编辑模式
(WebBrowser1.Document as IHTMLDocument2).designMode := 'off';
(WebBrowser1.Document as IHTMLDocument2).execCommand('BrowseMode',False,1);
///编辑模式时 回车换行时行间距太大
在DownloadComplete事件中
(wb_Editor.Document as IHTMLDocument2).execCommand('formatblock',False,'
///选中文本编辑
///设置字体
//名称 (WebBrowser1.Document as IHTMLDocument2).execCommand('FontName', False,'宋体');
//大小 (WebBrowser1.Document as IHTMLDocument2).execCommand('FontSize', False,7);///字体大小是从1到7
样式
//粗体 (WebBrowser1.Document as IHTMLDocument2).execCommand('Bold', False,1);
//斜体 (WebBrowser1.Document as IHTMLDocument2).execCommand('Italic', False,1);
/下划线 (WebBrowser1.Document as IHTMLDocument2).execCommand('Underline', False,1);
/删除线 (WebBrowser1.Document as IHTMLDocument2).execCommand('StrikeThrough', False,1);
///超链接 (WebBrowser1.Document as IHTMLDocument2).execCommand('CreateLink', False,1);
///删除超链接 (WebBrowser1.Document as IHTMLDocument2).execCommand('UnLink', False,1);
///设置
///设置文字前景色 (WebBrowser1.Document as IHTMLDocument2).execCommand('ForeColor',False,'Red');
///设置文字背景色 (WebBrowser1.Document as IHTMLDocument2).execCommand('BackColor',False,'Blue');
///设置下标 (WebBrowser1.Document as Ihtmldocument2).execCommand('SubScript',False,1);
///设置上标 (WebBrowser1.Document as Ihtmldocument2).execCommand('SuperScript',False,1);
///设置对齐方式
///设置左对齐 (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyLeft', False,0);
///设置中对齐 (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyCenter', False,0);
///设置右对齐 (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyRight', False,0);
///设置两端对齐 (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyFull', False,0);
///缩进
///向右缩进 (WebBrowser1.Document as Ihtmldocument2).execCommand('Indent',True,1);
///向左缩进 (WebBrowser1.Document as Ihtmldocument2).execCommand('Outdent',True,1);
///清除格式 (WebBrowser1.Document as Ihtmldocument2).execCommand('Removeformat',True,0);
///序列查看
///数字格式 (WebBrowser1.Document as Ihtmldocument2).execCommand('InsertOrderedList',True,0);
///圆点查看 (WebBrowser1.Document as Ihtmldocument2).execCommand('InsertUnorderedList',True,0);
///插入图片（静态） (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertImage', True,'');
(WebBrowser1.Document as IHTMLDocument2).execCommand('InsertImage', False,'C:\1.png');
///插入书签 (WebBrowser1.Document as Ihtmldocument2).execCommand('CreateBookmark',True,0);
///取消书签 (WebBrowser1.Document as Ihtmldocument2).execCommand('UnBookmark',True,0);
///插入HTML组件
///后面的字符串为这个控件的ID号
///直线 Line (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertHorizontalRule', True,'');
///按钮 Button (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertButton', True,'');
///复选框 CheckBox (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertInputCheckbox', True,'');
///单选框 Radio (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertInputRadio', True,'');
///编辑框 Edit (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertInputText', True,'');
///文本框 Memo (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertTextArea', True,'');
///密码框 PswEdit (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertInputPassword', True,'');
///组框架 GroupBox (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertIFrame', True,'');
///列表框 ListBox (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertSelectListbox', True,'');
///组合框 Combobox (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertSelectDropdown', True,'');
__、初始化成编辑模式
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Align:=alClient;
WebBrowser1.Navigate('about:blank');
while WebBrowser1.busy do
Application.ProcessMessages;
(WebBrowser1.Document as IHTMLDocument2).designMode := 'On';
end;
__、工具栏感应
function queryCommandValue(const cmdID: WideString): OleVariant; safecall;
-
字体名称
-
字符大小
function GetFontName():string;
begin
Result:=(Form1.webbrowser1.Document as IHTMLDocument2).queryCommandValue('FontName');
end;
function GetFontSize():string;
begin
Result:=(Form1.webbrowser1.Document as IHTMLDocument2).queryCommandValue('FontSize');
end;
function queryCommandState(const cmdID: WideString): WordBool; safecall;
-
粗体
-
斜体
-
下划线
-
删除线
-
对齐方式 左 中 右
-
数字排序
-
圆的排序
-
上标
-
下标
function IsBold():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('Bold');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsItalic():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('Italic');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsUnderline():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('Underline');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsStrikeThrough():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('StrikeThrough');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsSubScript():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('SubScript');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsSuperScript():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('SuperScript');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsJustifyLeft():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('JustifyLeft');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsJustifyCenter():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('JustifyCenter');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsJustifyRight():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('JustifyRight');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsJustifyFull():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('JustifyFull');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsInsertOrderedList():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('InsertOrderedList');
if bRtn then
Result:=True
else
Result:=False;
end;
function IsInsertUnorderedList():Boolean;
Var bRtn:Boolean;
begin
bRtn:= (Form1.webbrowser1.Document as IHTMLDocument2).queryCommandState('InsertUnorderedList');
if bRtn then
Result:=True
else
Result:=False;
end;
工具栏感应的使用
procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;Command: Integer; Enable: WordBool);
Var bRtn:Boolean;
begin
try
cbb_FontNameList.Text:=GetFontName();
cbb_FontSize.Text:=GetFontSize();
btn_Bold.Down:=IsBold();
btn_Italic.Down:=IsItalic();
btn_Underline.Down:=IsUnderline();
btn_strikethrough.Down:=IsStrikeThrough();
btn_SubScript.Down:=IsSubScript();
btn_SuperScript.Down:=IsSuperScript();
ToolButton_AlignTwo.Down:=IsJustifyFull();
ToolButton_AlignLeft.Down:=IsJustifyLeft();
ToolButton_AlignCenter.Down:=IsJustifyCenter();
ToolButton_AlignRight.Down:=IsJustifyRight();
ToolButton_UnoredredList.Down:=IsInsertUnorderedList();
ToolButton_OrderedList.Down:=IsInsertOrderedList();
except
Exit;
end;
end;
__、截图
先截图然后保存到 C:\Windows\temp
然后使用方法(WebBrowser1.Document as IHTMLDocument2).execCommand('InsertImage', False, 'C:\1.jpg');插入到指定位置
aaaa
__、______
__、______
aaaa
__、______
__、______
aaaa
__、______
__、______
aaaa
__、______
__、表格操作
aaaa
__、______
aaaa
__、______
aaaa
__、WebBrowser选中文本操作
设置Webbrowser的内容
//获得WebBrowser1里的文本相当于 Caption = Webbrowser1.Text
//获得当前选中的文本 Webrowser.Selection.Text
//获得当前选中的文本 Webrowser.Selection.HTML
//设置选中的文本Webrowser.Selection.Text="ABC";
function GetSelText():string;
var
Doc: IHtmlDocument2;
begin
Result:=( (Form1.WebBrowser1.Document as IHTMLDocument2).selection.createRange as IHtmlTxtRange).text;
end;
procedure SetSelText(s:string);
var
Doc: IHtmlDocument2;
begin
( (Form1.WebBrowser1.Document as IHTMLDocument2).selection.createRange as IHtmlTxtRange).text:=s;
end;
function GetSelHtmlText():string;
var
Doc: IHtmlDocument2;
begin
Result:=( (Form1.WebBrowser1.Document as IHTMLDocument2).selection.createRange as IHtmlTxtRange).htmlText;
end;
procedure SetSelHtmlText(s:string);
var
Doc: IHtmlDocument2;
begin
( (Form1.WebBrowser1.Document as IHTMLDocument2).selection.createRange as IHtmlTxtRange).pasteHTML(s);
end;
__、______
Application.ProcessMessages;
//Webbrowser的文本等于什么
(WebBrowser1.Document as IHTMLDocument2).body.innerHTML := 'abc';
WebBrowser1.OleObject.document.body.innerText :='abc' //文本
WebBrowser1.OleObject.Document.Writeln('ok');
webbrowser.OleObject.Document.Writeln(SynEdit.Text); //LOAD HTML
webbrowser.Refresh;
(WebBrowser1.Document as IHTMLDocument2).selection.clear; //删除选中区的内容。
Caption:=(WebBrowser1.Document as IHTMLDocument2).title; //获取当前文档的标题
Caption:=WebBrowser1.LocationName;//获取当前文档的标题
WebBrowser1.OleObject.document.body.background := 'C:\1.png';//Webbrowser的背景图片
WebBrowser1.OleObject.document.body.bgcolor := '#FF0000'; //Webbrowser的背景色
show a miniature view of a Webpage in TWebbrowser?
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
WebBrowser1.OleObject.Document.Body.Style.Zoom :=0.50;
end;
WebBrowser1.OleObject.Document.Body.Style.Zoom := 0.50;//WebBrowser 中页面的放大或缩小 百分比
WebBrowser1.OleObject.Document.designMode:='On';//编辑模式
WebBrowser1.OleObject.Document.designMode:='Off';//浏览模式
WebBrowser1.OleObject.document.body.contentEditable := CheckBox1.Checked;//是让整个页面可编辑, 也可以单独编辑某个元素
//定位光标到指定位置
//判断Webbrowser是否修改过
//使用网页弹消息
(Webbrowser1.Document as IHTMLDocument2).parentWindow.alert('aaaa');
WebBrowser1.OleObject.document.body.style.fontSize :=StrToInt(cbb_Style.Text);//设置全部的字体大小
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
__、______
aaaa
Webbrowser Bug
当Webbrowser处于编辑模式 此时如果往里面粘贴大量文本 并且使用 水平和垂直的滚动条出现 当拖拽垂直滚动条时 则出现以下问题
aaaa
来自为知笔记(Wiz)Time=2013-06-06 00:03:30
参考：http://m.blog.csdn.net/blog/fghydx/22373577