Delphi TWebBrowser

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方法来撤销正在执行的访问操作<br/>

WebBrowser控件的事件:

<br/>

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头的请求发送到服务器 <br><br/>

初始化和终止化 这几句话放在主窗口所有语句之后，“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 = - then
     //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+;   //加减进行上下滚动
    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、禁止弹出窗口

procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;  var Cancel: 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[..] of Char;
const
   ie = 'Internet Explorer_Server';
begin
   case nCode <  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[], @ie[]) =  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, , GetCurrentThreadId()) ;
end;

//Form OnDestroy
procedure TWebBrowserForm.FormDestroy(Sender: TObject) ;
begin
   if MouseHook <>  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快捷方式

8、设置焦点 (当Webbrowser处于编辑模式)
TWebBrowser非常特殊，它从TWinControl继承来的SetFocus方法并不能使得它所包含的文档获得焦点

//方法1
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
   if Form1.WebBrowser1.Document <> nil then
     with WebBrowser1.Application as IOleobject do
        DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, , 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
    : Caption :='最大';
    : Caption :='较大';
    : Caption :='中';
    : Caption :='较小';
    : 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 <>  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, , , 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 := ;
    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   =   $;
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      =   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, , , 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应该从注册表来，帮助有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 := ;
   (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:='<meta http-equiv="Content-Type" content="text/html; charset=gbk"/>'+HTMLCode;
         sl.Text := HTMLCode;
         sl.SaveToStream(ms) ;
         ms.Seek(, ) ;
         (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,);
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,);   //尚未实现
///打开    WebBrowser1.ExecWB(OLECMDID_OPEN,);
///保存    WebBrowser1.ExecWB(OLECMDID_SAVE,); //无保存网页的能力
///另存    WebBrowser1.ExecWB(OLECMDID_SAVEAS,);//网页，仅 HTML (*.htm;*.html)
///-
///打印     WebBrowser1.ExecWB(OLECMDID_PRINT,);
///打印预览  WebBrowser1.ExecWB(OLECMDID_PRINTPREVIEW,);
///页面设置  WebBrowser1.ExecWB(OLECMDID_PAGESETUP,);
///-
///属性     WebBrowser1.ExecWB(OLECMDID_PROPERTIES,);

///编辑
///撤销    WebBrowser1.ExecWB(OLECMDID_REDO ,);
///重做    WebBrowser1.ExecWB(OLECMDID_UNDO ,);
///-
///复制    WebBrowser1.ExecWB(OLECMDID_COPY,);
///剪切    WebBrowser1.ExecWB(OLECMDID_PASTE,);
///粘贴    WebBrowser1.ExecWB(OLECMDID_CUT ,);
///删除    WebBrowser1.ExecWB(OLECMDID_DELETE,);
///-
///全选    WebBrowser1.ExecWB(OLECMDID_SELECTALL,);
///不选    WebBrowser1.ExecWB(OLECMDID_CLEARSELECTION,);
    
///查找/替换
///查找对话框    WebBrowser1.ExecWB(OLECMDID_FIND,);

__、替换对话框

__、剪切板

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, );
    for i:= to FormatCount -  do
    begin
      GetClipboardFormatName(Formats[i], Buffer, );
      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, , , 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,);
///网页编辑模式 
    (WebBrowser1.Document as IHTMLDocument2).designMode := 'off';
    (WebBrowser1.Document as IHTMLDocument2).execCommand('BrowseMode',False,);

///选中文本编辑
///设置字体
//////名称        (WebBrowser1.Document as IHTMLDocument2).execCommand('FontName', False, '宋体');
//////大小        (WebBrowser1.Document as IHTMLDocument2).execCommand('FontSize', False, );///字体大小是从1到7
////样式 
//////粗体        (WebBrowser1.Document as IHTMLDocument2).execCommand('Bold', False, );
//////斜体        (WebBrowser1.Document as IHTMLDocument2).execCommand('Italic', False, );
/////下划线       (WebBrowser1.Document as IHTMLDocument2).execCommand('Underline', False, );
/////删除线       (WebBrowser1.Document as IHTMLDocument2).execCommand('StrikeThrough', False, );

///超链接          (WebBrowser1.Document as IHTMLDocument2).execCommand('CreateLink', False, );
///删除超链接      (WebBrowser1.Document as IHTMLDocument2).execCommand('UnLink', False, );

///设置
///设置文字前景色   (WebBrowser1.Document as IHTMLDocument2).execCommand('ForeColor',False, 'Red');
///设置文字背景色   (WebBrowser1.Document as IHTMLDocument2).execCommand('BackColor',False, 'Blue');

///设置下标        (WebBrowser1.Document as Ihtmldocument2).execCommand('SubScript',False,);
///设置上标        (WebBrowser1.Document as Ihtmldocument2).execCommand('SuperScript',False,);

///设置对齐方式
///设置左对齐       (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyLeft', False, );
///设置中对齐       (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyCenter', False, );
///设置右对齐       (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyRight', False, );
///设置两端对齐     (WebBrowser1.Document as IHTMLDocument2).execCommand('JustifyFull', False, );

///缩进
///向右缩进        (WebBrowser1.Document as Ihtmldocument2).execCommand('Indent',True,);
///向左缩进        (WebBrowser1.Document as Ihtmldocument2).execCommand('Outdent',True,);

///清除格式        (WebBrowser1.Document as Ihtmldocument2).execCommand('Removeformat',True,);

///序列查看
///数字格式         (WebBrowser1.Document as Ihtmldocument2).execCommand('InsertOrderedList',True,);
///圆点查看         (WebBrowser1.Document as Ihtmldocument2).execCommand('InsertUnorderedList',True,);

///插入图片（静态）  (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertImage', True, '');
                   (WebBrowser1.Document as IHTMLDocument2).execCommand('InsertImage', False, 'C:\1.png');
 
///插入书签 (WebBrowser1.Document as Ihtmldocument2).execCommand('CreateBookmark',True,);
///取消书签 (WebBrowser1.Document as Ihtmldocument2).execCommand('UnBookmark',True,);
 
///插入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;

1. 字体名称
2. 字符大小

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;

1. 粗体
2. 斜体
3. 下划线
4. 删除线
5. 对齐方式 左 中 右
6. 数字排序
7. 圆的排序
8. 上标
9. 下标

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

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、表格操作

__、______

__、______

__、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 := .;
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

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

__、______

Webbrowser Bug
当Webbrowser处于编辑模式 此时如果往里面粘贴大量文本 并且使用 水平和垂直的滚动条出现 当拖拽垂直滚动条时 则出现以下问题

来自为知笔记(Wiz)Time=2013-06-06 00:03:30