Вставьте СТИЛИ в TWebBrowser

Question

Вставьте СТИЛИ в TWebBrowser

Я использую TWebBrowser в качестве редактора GUI для пользователей. Я хочу иметь возможность вставлять веб-элементы управления в документ. Простым примером будет флажок. (Я могу уточнить, почему, если это необходимо). У меня все это работает, когда я сначала собираю 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 =

'.selected {' # $ D # $ A 'font-weight: bold;' # $ D # $ A '// background-color: yellow;' # $ D # $ A '}' # $ D # $ A'.unselected { '# $ D # $ A' font-weight: normal; '# $ D # $ A' // background-color: white; '# $ D # $ A'} '# $ D # $ A # $ D # $ A

Но я попытался сделать так, чтобы StyleText был чем-то простым, например, "привет", и он все еще не работал.

Поиск Google "OLE ERROR 800A0258" обнаруживает нескольких других людей, у которых были подобные проблемы, такие как здесь и здесь - этот более поздний пользователь, кажется, указывает, что он исправил проблему с помощью.OuterHTML, но я пробовал это с похожей сгенерированной ошибкой. Эта тема, кажется, указывает, что.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;

Может кто-нибудь помочь разобраться, как настроить СТИЛИ в <STYLE> раздел существующего HTML-документа в TWebBrowser?

1

html delphi twebbrowser innertext

Источник

user3491225 09 мар '16 в 23:36

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

1

Источник

user3491225 14 мар '16 в 02:47

Другие вопросы по тегам html delphi twebbrowser innertext

user5855039 10 мар '16 в 02:32 2016-03-10 02:32 · Accepted Answer · 2016-03-10 02:32

Если у вас есть действительный IHTMLDocument2, то вы можете вызвать его createStyleSheet (). Он вернет экземпляр IHTMLStyleSheet. Вы можете использовать его cssText свойство устанавливать стиль.

Убедитесь, что вы учитываете кодировку символов документа.

2

Источник

user5855039 10 мар '16 в 02:32