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方法来撤销正在执行的访问操作<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 = -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:='<meta http-equiv="Content-Type" content="text/html; charset=gbk"/>'+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,'<div>');
///选中文本编辑
///设置字体

//名称        (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;

  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

 

 

 

__、______

__、______

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

相关推荐
程序员的必经之路! 【限时优惠】 现在下单,还享四重好礼: 1、教学课件免费下载 2、课程案例代码免费下载 3、专属VIP学员群免费答疑 4、下单还送800元编程大礼包 【超实用课程内容】  根据《2019-2020年中国开发者调查报告》显示,超83%的开发者都在使用MySQL数据库。使用量大同时,掌握MySQL早已是运维、DBA的必备技能,甚至部分IT开发岗位也要求对数据库使用和原理有深入的了解和掌握。 学习编程,你可能会犹豫选择 C++ 还是 Java;入门数据科学,你可能会纠结于选择 Python 还是 R;但无论如何, MySQL 都是 IT 从业人员不可或缺的技能!   套餐中一共包含2门MySQL数据库必学的核心课程(共98课时)   课程1:《MySQL数据库从入门到实战应用》   课程2:《高性能MySQL实战课》   【哪些人适合学习这门课程?】  1)平时只接触了语言基础,并未学习任何数据库知识的人;  2)对MySQL掌握程度薄弱的人,课程可以让你更好发挥MySQL最佳性能; 3)想修炼更好的MySQL内功,工作中遇到高并发场景可以游刃有余; 4)被面试官打破沙锅问到底的问题问到怀疑人生的应聘者。 【课程主要讲哪些内容?】 课程一:《MySQL数据库从入门到实战应用》 主要从基础篇,SQL语言篇、MySQL进阶篇三个角度展开讲解,帮助大家更加高效的管理MySQL数据库。 课程二:《高性能MySQL实战课》主要从高可用篇、MySQL8.0新特性篇,性能优化篇,面试篇四个角度展开讲解,帮助大家发挥MySQL的最佳性能的优化方法,掌握如何处理海量业务数据和高并发请求 【你能收获到什么?】  1.基础再提高,针对MySQL核心知识点学透,用对; 2.能力再提高,日常工作中的代码换新貌,不怕问题; 3.面试再加分,巴不得面试官打破沙锅问到底,竞争力MAX。 【课程如何观看?】  1、登录CSDN学院 APP 在我的课程中进行学习; 2、移动端:CSDN 学院APP(注意不是CSDN APP哦)  本课程为录播课,课程永久有效观看时长 【资料开放】 课件、课程案例代码完全开放给你,你可以根据所学知识,自行修改、优化。  下载方式:电脑登录课程观看页面,点击右侧课件,可进行课程资料的打包下载。
©️2020 CSDN 皮肤主题: 技术黑板 设计师:CSDN官方博客 返回首页