WebBrowser - Проверить наличие Hyperlink в Textrange

[AvRob]

var WB_document:IHTMLDocument2;
TextRange1:IHTMLTxtRange;
begin
...
TextRange1:=(WB_document.selection. createRange as IHTMLTxtRange);

Как можно проверить является ли Textrange или его часть гиперссылкой или частью гиперссылки ?

[volvo877]

Как-то вот так:

var
   WB_document:IHTMLDocument2;
   TextRange1:IHTMLTxtRange;
   txtRangeParent : IHTMLElement;
   Link : IHTMLAnchorElement;
// ... 
   TextRange1:=(WB_document.selection. createRange as IHTMLTxtRange);
   txtRangeParent := TextRange1.parentElement;
   txtRangeParent.QueryInterface(IHTMLAnchorElement, Link);
   if Assigned(Link) then ShowMessage(Link.href);
// ...

[AvRob]

Спасибо.

Однако это не всегда даст верный ответ.

В ParentElement может быть несколько Link-ов, которые не будут иметь ничего общего с Textrange1.

Нужно проверить Textrange1 на пересечение с Link-ом и найти этот Link.

[AvRob]

txtRangeParent := TextRange1.parentElement;
txtRangeParent.QueryInterface(IHTMLAnchorElement, Link);
if Assigned(Link) then ShowMessage(Link.href);

верно, когда selection совпадает с Link или находится внутри Link-а.

не верно, если какая-то часть selection находится вне Link-a.

[volvo877]

В таком случае, другого варианта, как сначала проверять приведенным выше способом (или через Supports(TextRange1.parentElement, IHTMLAnchorElement, Link), так даже проще), а если результат отрицательный - проверять TextRange1.htmlText на наличие тега '<A>', и вытаскивать руками из него href, я не вижу.

Можно, конечно, взять Children у родителя, пройти по всем дочерним элементам (возможно даже рекурсивно), и проверить, есть ли среди них Anchor-ы, но если есть, как ты IHTMLEmelent превратишь в IHTMLTxtRange, чтобы проверить свойством inRange, находится ли найденный среди дочерних элементов anchor внутри selection, или нет?

[AvRob]

Спасибо.

Наверное так и придется сделать.

[volvo877]

Есть еще одна идея, проверь:

procedure TForm1.Button1Click(Sender: TObject);
var
   WB_Doc : IHTMLDocument2;
   TR, TTR : IHTMLTxtRange;
   Element : IHTMLElement;
   i : Integer;
   Links : IHTMLElementCollection;
begin
   WB_Doc := WebBrowser1.Document as IHTMLDocument2;
   TR := (WB_Doc.selection.createRange as IHTMLTxtRange);

   Links := WB_Doc.links;
   TTR := (WB_Doc.body as IHTMLBodyElement).createTextRange;

   for i := 0 to links.length - 1 do
   begin
      Element := links.item(i, varEmpty) as IHTMLElement;
      if Assigned(Element) then
      begin
         TTR.moveToElementText(Element);
         if ((TTR.compareEndPoints('StartToStart', tr) = 1) and
             (TTR.compareEndPoints('StartToEnd', tr) = -1)) or
            ((TTR.compareEndPoints('EndToStart', tr) = 1) and
             (TTR.compareEndPoints('EndToEnd', tr) = -1)) then
         begin
            ShowMessage((Element as IHTMLAnchorElement).href);
         end;
      end;
   end;
end;

По идее должно выдавать все линки, находящиеся внутри selection.

[AvRob]

Так оно и есть!

Работает отлично, то что нужно!!

Спасибо!