Question

我正在使用TWebBrowser作为用户的编辑器GUI。我希望能够将Web控件插入到文档中。一个简单的例子就是一个复选框。（如果需要，我可以详细说明原因）。当我第一次组装HTML文档（带有STYLE和SCRIPTS部分）然后将它块传递给TWebBrowser时，我就完成了所有这些工作。但现在我希望能够将我的元素插入到现有文档中。

我在下面有这个代码，但是它导致了OLE错误（参见代码中的注释）：

procedure THTMLTemplateDocument.EnsureStylesInWebDOM;
var StyleBlock : IHTMLElement;
    StyleText: string;
begin
  StyleBlock := FWebBrowser.GetDocStyle;
  if not assigned(StyleBlock) then
    raise Exception.Create('Unable to access <STYLE> block in web document');
  StyleText := FCumulativeStyleCodes.Text;
  StyleBlock.InnerText := StyleText; <--- generates "OLE ERROR 800A0258"
end;

以上代码中的被调用函数如下：

function THtmlObj.GetDocStyle: IHTMLElement;
//Return pointer to <STYLE> block, creating this if it was not already present.
var
  Document:    IHTMLDocument2;         // IHTMLDocument2 interface of Doc
  Elements:    IHTMLElementCollection; // all tags in document body
  AElement:    IHTMLElement;           // a tag in document body
  Style, Head: IHTMLElement;
  I:           Integer;                // loops thru Elements in document body
begin
  Result := nil;
  if not Supports(Doc, IHTMLDocument2, Document) then
    raise Exception.Create('Invalid HTML document');
  Elements := Document.all;
  for I := 0 to Pred(Elements.length) do begin
    AElement := Elements.item(I, EmptyParam) as IHTMLElement;
    if UpperCase(AElement.tagName) <> 'STYLE' then continue;
    result := AElement;
    break;
  end;
  if not assigned(Result) then begin
    Head := GetDocHead;
    if assigned(Head) then begin
      Style := Document.CreateElement('STYLE');
      (Head as IHTMLDOMNode).AppendChild(Style as IHTMLDOMNode);
      Result := Style;
    end;
  end;
end;

和

function THtmlObj.GetDocHead: IHTMLElement;
//Return pointer to <HEAD> block, creating this if it was not already present.
var
  Document:    IHTMLDocument2;         // IHTMLDocument2 interface of Doc
  Elements:    IHTMLElementCollection; // all tags in document body
  AElement:    IHTMLElement;           // a tag in document body
  Body:        IHTMLElement2;          // document body element
  Head:        IHTMLElement;
  I:           Integer;                // loops thru Elements in document body
begin
  Result := nil;
  if not Supports(Doc, IHTMLDocument2, Document) then
    raise Exception.Create('Invalid HTML document');
  if not Supports(Document.body, IHTMLElement2, Body) then
    raise Exception.Create('Can''t find <body> element');
  Elements := Document.all;
  for I := 0 to Pred(Elements.length) do begin
    AElement := Elements.item(I, EmptyParam) as IHTMLElement;
    if UpperCase(AElement.tagName) <> 'HEAD' then continue;
    Result := AElement;
    break;
  end;
  if not assigned(Result) then begin
    Head := Document.CreateElement('HEAD');
    (Body as IHTMLDOMNode).insertBefore(Head as IHTMLDOMNode, Body as IHTMLDOMNode);
    //now look for it again
    Elements := Document.all;
    for I := 0 to Pred(Elements.length) do begin
      AElement := Elements.item(I, EmptyParam) as IHTMLElement;
      if UpperCase(AElement.tagName) <> 'HEAD' then continue;
      Result := AElement;
      break;
    end;
  end;
end;

当我运行它时，StyleText =

＆＃39;。选择{＆＃39;＃$ D＃$ A＆＃39; font-weight：bold;＆＃39;＃$ D＃$ A＆＃39; // background-color：yellow;＆＃39;＃$ D＃$ A＆＃39;}＆＃39;＃$ D＃$ A＆＃39;。未选择{＆＃39;＃$ D＃$ A＆＃39; font-weight：normal;＆＃39;＃$ D＃$ A＆＃39; // background-color：white;＆＃39;＃$ D＃$ A＆＃39;}＆＃39;＃$ D＃$ A＃$ D＃$ A

但我尝试将StyleText变成简单的类似“你好”的东西，它仍然会崩溃。

Google搜索＆＃34; OLE ERROR 800A0258＆＃34;揭示了其他几个有类似问题的人，比如here和here - 这个后来的用户似乎表明他通过使用.OuterHTML解决了这个问题，但是我尝试了这个并且产生了类似的错误。 This线程似乎表明.InnerText是只读的。但是在接口声明（见下文）中，似乎有一种设置方法（即不是只读的）。

// *********************************************************************//
// Interface: IHTMLElement
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}
// *********************************************************************//
  IHTMLElement = interface(IDispatch)
    ['{3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}']
...
    procedure Set_innerHTML(const p: WideString); safecall;
    function Get_innerHTML: WideString; safecall;
    procedure Set_innerText(const p: WideString); safecall;
    function Get_innerText: WideString; safecall;
    procedure Set_outerHTML(const p: WideString); safecall;
    function Get_outerHTML: WideString; safecall;
    procedure Set_outerText(const p: WideString); safecall;
    function Get_outerText: WideString; safecall;
...
    property innerHTML: WideString read Get_innerHTML write Set_innerHTML;
    property innerText: WideString read Get_innerText write Set_innerText;
    property outerHTML: WideString read Get_outerHTML write Set_outerHTML;
    property outerText: WideString read Get_outerText write Set_outerText;
...
  end;

任何人都可以帮助弄清楚如何在TWebBrowser的现有HTML文档的<STYLE>部分设置STYLES吗？

Answer 1

如果您有有效的IHTMLDocument2，则可以调用其createStyleSheet()。它将返回IHTMLStyleSheet实例。您可以使用其"newOrExisting": "new", "configHash": { "new": "[concat(parameters('templateBaseUrl'),'partials/QA.json')]", "existing": "[concat(parameters('templateBaseUrl'),'partials/Production.json')]" } "configTemplate": "[variables('configHash')[parameters('Settings').newOrExisting]]"属性来设置样式。

请务必考虑文档的字符编码。

Answer 2

根据@Zamrony P. Juhara的指导，我想出了以下代码。我发帖以防将来可以帮助其他人。

procedure THtmlObj.AddStylesToExistingStyleSheet(StyleSheet: IHTMLStyleSheet; SelectorSL, CSSLineSL : TStringList);
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
//  The first SL will contain the selector text
//  the second SL will contain all the CSS in one line (divided by ";"'s)
var
  SLIdx, RuleIdx, p: integer;
  SelectorText, CSSText, OneCSSEntry : string;
begin
  if not assigned(StyleSheet) then begin
    raise Exception.Create('Invalid StyleSheet');
  end;
  for SLIdx := 0 to SelectorSL.Count - 1 do begin
    SelectorText := SelectorSL.Strings[SLIdx];
    if SlIdx > (CSSLineSL.Count - 1) then break;
    CSSText := CSSLineSL.Strings[SLIdx];
    while CSSText <> '' do begin
      p := Pos(';', CSSText);
      if p > 0 then begin
        OneCSSEntry := MidStr(CSSText, 1, p);
        CSSText := MidStr(CSSText, p+1, Length(CSSText));
      end else begin
        OneCSSEntry := CSSText;
        CSSText := '';
      end;
      RuleIdx := StyleSheet.Rules.length;
      StyleSheet.addRule(SelectorText, OneCSSEntry, RuleIdx);
    end;
  end;
end;


function THtmlObj.AddStyles(SelectorSL, CSSLineSL : TStringList) :     IHTMLStyleSheet;
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
//  The first SL will contain the selector text
//  the second SL will contain all the CSS in one line (divided by ";"'s)
var
  Document:      IHTMLDocument2;              // IHTMLDocument2 interface of Doc
  StyleSheets:   IHTMLStyleSheetsCollection;  // document's style sheets
  StyleSheet:    IHTMLStyleSheet;             // reference to a style sheet
  OVStyleSheet:  OleVariant;                  // variant ref to style sheet
  Idx:           integer;
begin
  Result := nil;
  if not Supports(Doc, IHTMLDocument2, Document) then begin
    raise Exception.Create('Invalid HTML document');
  end;
  StyleSheets := Document.styleSheets;
  Idx := Document.StyleSheets.length;
  OVStyleSheet := Document.createStyleSheet('',Idx);
  if not VarSupports(OVStyleSheet, IHTMLStyleSheet, StyleSheet) then begin
    raise Exception.Create('Unable to create valid style sheet');
  end;
  Result := StyleSheet;
  AddStylesToExistingStyleSheet(StyleSheet, SelectorSL, CSSLineSL);
end; //AddStyles

将STYLEs插入TWebBrowser

2 个答案: