Delphi WebBrowser控件的使用（大全 good）

2021-09-17 01:02:51

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事件提供了一个命令状态改变后的处理功能，通过该事件能够判断执行某个命令后的当前浏览器状态，例如控制“后退”、“前进”或“停止”按钮是否可用，代码如下：

Delphi WebBrowser控件的使用（大全 good）


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快捷方式

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）。

Delphi WebBrowser控件的使用（大全 good）


//读取当前页面字体大小

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;

整理收藏夹

Delphi WebBrowser控件的使用（大全 good）


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、获取网页源码相关

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;

字体名称
字符大小


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

__、______

__、表格操作

__、______

__、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);//设置全部的字体大小