• WebBrowser组件和MSHTML 在Delphi中的使用


    MSHTML把HTML页面中的元素封装成了IHTMLInputElement、 IHTMLInputButtonElement、IHTMLInputTextElement、IHTMLTextAreaElement、IHTMLTitleElement、IHTMLFormElement等等组件接口。
    在程序中可以通过MSHTML提供的IHTMLDocument2接口得到整个Document对象,IHTMLElementCollection接口得到所有页面元素的集合,通过该接口的Item方法可以得到具体的某个组件,然后设置和读取该组件的属性值。
    下面是一些常用功能的事例代码.
    1. 打开某个页面:
    web.Navigate(ExtractFilePath(Application.ExeName) + 'Template/login.html');
    2. 取出页面中某个HtmlElement的Value属性值:
    function GetValueByElementName(web: TWebBrowser; elementName: string; index: integer): string;
    begin
    result := (((web.Document as IHTMLDocument2).body.all as
    IHTMLElementCollection).item(elementName, index) as IHTMLInputElement
    ).value
    end;
    3. 给HtmlElement设置Value属性
    procedure SetValueTextAreaName(web: TWebBrowser; elementName, value: string;index: integer);
    begin
    (((web.Document as IHTMLDocument2).body.all as
    IHTMLElementCollection).item(elementName, index) as IHTMLTextAreaElement
    ).value := value;
    end;
    4. 判断页面执行结果是否成功
    因为Web应用中如果出错的一般是采用错误页面的方式呈现给最终用户,所以我们也无法抓到Http错误,只能通过在webBeforeNavigate2事件中将URL参数记录到全局变量中, 然后在webDocumentComplete事件中根据URL参数和全局变量中的URL参数来判断执行结果是否正确.当然,这样需要将页面地址编码到代码中,降低了灵活性,但是这也是我能想到的唯一的方法,如果大家有什么好的方法,请告诉我哦.
    5. 屏蔽鼠标右键和某些快捷键
    本功能需要在webBrowser的窗口中加入ApplicationEvents组件,设置它的OnMessage事件代码如下即可.
    procedure TwebAdapterForm.ApplicationEvents1Message(var Msg: tagMSG;
    var Handled: Boolean);
    const
    _KeyPressMask = $80000000;
    begin
    //禁用右键
    with Msg do
    begin
    if not IsChild(web.Handle, hWnd) then Exit;
    Handled := (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_CONTEXTMENU);
    end;
    //禁止Ctrl + N
    //禁止Ctrl + F
    //禁止Ctrl + A
    if Msg.message = WM_KEYDOWN then
    begin
    if ((Msg.lParam and _KeyPressMask) = 0) and
    (GetKeyState(VK_Control) <0) and ((Msg.wParam = Ord('N'))
    or (Msg.wParam = Ord('F')) or (Msg.wParam = Ord('A'))) then
    begin
    Handled := True;
    end;
    end;
    end;
    6. 在页面关闭的时候,同时关掉包含页面的VCL Form.(仅限 InternetExplorer 6.0)
    本功能需要卸载掉Delphi自带的 WebBrowser组件,安装ActionX组件(Microsoft Internet Controls V1.1),而且以后的程序只能运行在安装有Internet Explorer 6.0 的环境下.具体方法如下:
    在WebBrowser组件的OnWindowClosing事件中,输入self.close; 代码即可.如果需要阻止窗口的关闭, 设置CanClose参数的值为Flase.
    7. 如何将页面中超链接新开的页面窗口包到指定的VCL窗口中.
    procedure TForm1.webNewWindow2(Sender: TObject; var ppDisp: IDispatch;
    var Cancel: WordBool);
    var
    form : TForm1;
    begin
    form := TForm1.Create(nil);
    ppDisp := form.web.DefaultDispatch;
    form.Show;
    end;
    8. 在WebBrowser加载html页面完成后,在页面顶端插入HTML代码, 下面两种方式斗可以.
    {1. ----------------------------------------------------------------}
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Range: IHTMLTxtRange;
    begin
    Range := ((WebBrowser1.Document as IHTMLDocument2).body as
    IHTMLBodyElement).createTextRange;
    Range.collapse(False);
    Range.pasteHTML('<br/><b>Hello!</b>');
    end;
    {2. ----------------------------------------------------------------}
    procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
    const pDisp: IDispatch; var URL: OleVariant);
    var
    WebDoc: HTMLDocument;
    WebBody: HTMLBody;
    begin
    WebDoc := WebBrowser1.Document as HTMLDocument;
    WebBody := WebDoc.body as HTMLBody;
    WebBody.insertAdjacentHTML('BeforeEnd', '<h1>Hello World!</h1>');
    end;
    9. 将页面中显示的内容全部选中,然后粘贴到Word文档中.
    WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT);//全选网页
    WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT); //复制网页
    WordDocu.Range.Paste; //word文档粘贴
    WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT); //取消全选
    注:WebBrowser的Document属性值和WordDocument的Document属性值必须都不为nil.
    10. 如何解决网页不响应回车事件
    public
    { Public declarations }
    procedure MsgHandle(var Msg :TMsg; var Handled :Boolean);
    end;
    var
    Form1: TForm1;
    FOleInPlaceActiveObject :IOleInPlaceActiveObject;
    implementation
    {$R *.DFM}
    procedure TForm1.MsgHandle(var Msg :TMsg; var Handled :Boolean);
    var
    iOIPAO :IOleInPlaceActiveObject;
    Dispatch :IDispatch;
    begin
    if WebBrowser1 =nil then
    begin
    Handled :=False;
    Exit;
    end;
    Handled :=(IsDialogMessage(WebBrowser1.Handle, Msg) =True);
    if (Handled) and (not WebBrowser1.Busy) then
    begin
    if FOleInPlaceActiveObject =nil then
    begin
    Dispatch :=WebBrowser1.Application;
    if Dispatch <>nil then
    begin
    Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
    if iOIPAO <>nil then
    FOleInPlaceActiveObject :=iOIPAO;
    end;
    end;
    end;
    if FOleInPlaceActiveObject <>nil then
    if ((Msg.message =WM_KEYDOWN) or (Msg.Message =WM_KEYUP)) and ((Msg.wParam =VK_BACK) or (Msg.wParam =VK_LEFT) or (Msg.wParam =VK_RIGHT)) then
    else
    FOleInPlaceActiveObject.TranslateAccelerator(Msg);
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    Application.OnMessage :=MsgHandle;
    end;
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
    FOleInPlaceActiveObject :=nil;
    end;
    11. 如何在WebBrowser中调用当前页面中的javascript函数SayHello()
    WebBrowser1.OleObject.
    Document.parentWindow.execScript('SayHello()', 'javascript');
    //or
    (WebBrowser1.Document as IHTMLDocument2
    ).parentWindow.execScript('SayHello()', 'javascript')
    //or
    webrowser1.document.script.SayHello();

  • 相关阅读:
    Redis 如何与数据库事务保持一致
    QQ、微信 唯一登陆设计
    Node.js Sequelize如何实现数据库的读写分离
    node.js web应用优化之读写分离
    在docker中使用mysql数据库,在局域网访问
    docker常用管理命令
    基于 Egg.js 框架的 Node.js 服务构建之用户管理设计
    使用mousedown、mousemove、mouseup实现拖拽效果
    VUE中事件修饰符:stop prevent self capture
    基于jsplumb插件制作可拖拽、保存流程图、重绘保存后的流程图总结
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/1816871.html
Copyright © 2020-2023  润新知