TWebBrowser - изменить текст ссылки

[AvRob]

Как можно программно в Delphi в компоненте TWebBrowser изменить текст ссылки со слова "Ссылка"

(<p><a href="http://www.ii.com" title="Здесь текст подсказки">Ссылка</a> на текст документа</p>)

на слова "Ссылка на текст документа"

(<p><a href="http://www.ii.com" title="Здесь текст подсказки">Ссылка на текст документа</a></p>)

[Stilet]

изменить текст ссылки

И так во всех ссылках?

[AvRob]

Есть одна гиперссылка "Это есть ссылка"

(имеем <p><a href="http://www.ii.com" title="Здесь текст подсказки">Это есть ссылка</a> на текст документа</p>)

В TWEBBrowser мышью выделяем текст "ссылка на текст документа".

Нужно изменить текст гиперссылки на выделенный мышью текст, т.е. нужно изменить текст гиперссылки
с "Это есть ссылка"
на "ссылка на текст документа".

(должны получить <p>Это есть <a href="http://www.ii.com" title="Здесь текст подсказки">ссылка на текст документа</a></p>)

[volvo877]

AvRob, как находить ссылку, присутствующую в выделенном тексте, я тебе уже вот тут показывал, просто дополню код, чтобы он делал необходимое тебе действие:

procedure TForm1.Button1Click(Sender: TObject);
var
   wb_doc : IHTMLDocument2;
   TR, TTR : IHTMLTxtRange;
   Links : IHTMLElementCollection;
   Element : IHTMLElement;
   i, txt_pos : Integer;

   txtBefore, txtAfter : string;
   outHTML, pt : WideString;
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
            // pt - InnerText родительского элемента
            pt := Element.parentElement.innerText;

            // Текст, который будет перед ссылкой
            txtBefore := Copy(pt, 1, Pos(TR.text, pt) - 1);

            txt_pos := Pos(TR.text, pt) + Length(TR.text);
            // Текст, который будет после ссылки
            txtAfter := Copy(pt, txt_pos, Length(pt) - (txt_pos - 1));

            // Заменяем текст ссылки на содержимое выделенного TextRange
            outHTML := Element.outerHTML;
            Delete(outHTML, Pos('>', outHTML) + 1, Length(Element.innerText));
            Insert(TR.text, outHTML, Pos('>', outHTML) + 1);

            // И изменяем внутренний HTML родительского (для ссылки) элемента
            Element.parentElement.innerHTML := txtBefore + outHTML + txtAfter;
         end;
      end;
   end;
end;

[Lesha]

http://jqbook.narod.ru/delphi/javascript.htm << - модуль jsWebbrowser 3

// jquery
$("p a").each(function() {
	var h = $(this).parent().html();
	h = h.replace(/<\/a>/ig,"");
	$(this).parent().html(h+"</a>");
});

//delphi

webbrowser1.runJS(
'$("p a").each(function() { '+
'	var h = $(this).parent().html(); '+
'	h = h.replace(/<\/a>/ig,"");  '+
'	$(this).parent().html(h+"</a>");  '+
'}); ');

[volvo877]

Lesha, кроме появления вот такого окна и последующего аварийного вылета что-то должно было произойти? Никак не происходит.

[AvRob]

Спасибо Volvo87.

Все нормально, однако

// Текст, который будет перед ссылкой
txtBefore := Copy(pt, 1, Pos(TR.text, pt) - 1);

неоднозначно определяет наше выделение.

Если текст TR.text="ссылка на текст документа" встречается в Element.parentElement.innerText несколько раз и наше выделение не первое из них.

И, по моему в TTR.compareEndPoints-ах нужно поменять "= 1" на ">=0", а "=-1" на "<=0

[Lesha]

Сообщение от volvo877

Lesha, кроме появления вот такого окна и последующего аварийного вылета что-то должно было произойти? Никак не происходит.

код, исходник в студию!

[AvRob]

Volvo877 Я немного поменял код, сейчас, помоему, однозначно определяется выделение.
Спасибо тебе еще раз!

Function TForm1.TREndPointsDistance(How:String;TR1:IHTMLTxtRange;TR2:IHTMLTxtRange):Integer;
var
  tempTR1:IHTMLTxtRange;
  EndPOintsOffset:integer;
begin
  Result:=0;
  tempTR1:=TR1.duplicate;

  EndPOintsOffset:=tr1.compareEndPoints(How,tr2);
  if Copy(LowerCase(how),1,5)='start'
  then
    while EndPOintsOffset <> 0 do
    begin
      temptr1.moveStart('character',-EndPointsOffset);
      Result:=Result+EndPOintsOffset;
      EndPOintsOffset:=temptr1.compareEndPoints(How,tr2);
    end
  else
    while EndPOintsOffset <> 0 do
    begin
      temptr1.moveEnd('character',-EndPointsOffset);
      Result:=Result+EndPOintsOffset;
      EndPOintsOffset:=temptr1.compareEndPoints(How,tr2);
    end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  wb_doc : IHTMLDocument2;
  TRLink, TRSel : IHTMLTxtRange;
  Links : IHTMLElementCollection;
  Element : IHTMLElement;
  i, txt_pos : Integer;

  LinkInnerText,TextBeforeLink,LinkOuterText,TextAfterLink:WideString;
  StartPointsOffset,EndPointsOffset:Integer;

begin
  WB_Doc := WebBrowser1.Document as IHTMLDocument2;
  TRSel := (WB_Doc.selection.createRange as IHTMLTxtRange);

  Links := WB_Doc.links;
  TRLink := (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
      TRLink.moveToElementText(Element);
      if (TRLink.compareEndPoints('StartToEnd', TRSel) = -1) and
         (TRLink.compareEndPoints('EndToStart', TRSel) = 1) then
      begin
        // TRTotal - общая textrange - включает в себе TRLink и TRSel
        TRTotal:=TRLink.duplicate;

        // Текст, который будет перед ссылкой
        TextBeforeLink:='';
        LinkOuterText := Element.outerHTML;
        // Текст, который будет после ссылки
        TextAfterLink:='';

        // StartPointsOffset - расстояние в char междy начальными точками TRLink и TRSel
        StartPointsOffset:=TREndPointsDistance('StartToStart',TRLink,TRSel);
        // EndPointsOffset - расстояние в char междy конечными точками TRLink и TRSel
        EndPointsOffset:=TREndPointsDistance('EndToEnd',TRLink,TRSel);

        if (TRLink.compareEndPoints('StartToStart', TRSel) = -1 ) then
        begin
   // Начальная точка link левее начальной точки Selection
          TextBeforeLink:=Copy(element.innertext,1,-StartPointsOffset);
          LinkInnerText:=Copy(element.innertext,-StartPointsOffset+1,Length(element.innertext));
        end else
        begin
   // Начальная точка link равна или правее начальной точки Selection
          // устанавливаем левую границу общей TRTotal
          TRTotal.setEndPoint('StartToStart',TRSel);
          LinkInnerText:=Copy(TRSel.text,1,StartPointsOffset)+element.innertext;
        end;

        if (TRLink.compareEndPoints('EndToEnd', TRSel) >= 0 ) then
        begin
   // Конечная точка link равна или правее конечной точки Selection
          TextAfterLink:=Copy(LinkInnerText,Length(LinkInnerText)-EndPointsOffset+1,Length(LinkInnerText));
          LinkInnerText:=Copy(LinkInnerText,1,Length(LinkInnerText)-EndPointsOffset);
        end else
        begin
   // Конечная точка link левее конечной точки Selection
          // устанавливаем правую границу общей TRTotal
          TRTotal.setEndPoint('EndToEnd',TRSel);
          LinkInnerText:=LinkInnerText+
          Copy(TRSel.text,Length(TRSel.text)+EndPointsOffset+1,Length(TRSel.text));
        end;

      // Заменяем текст ссылки на содержимое выделенного TextRange
        Delete(LinkOuterText, Pos('>', LinkOuterText) + 1, Length(Element.innerText));
        Insert(LinkInnerText, LinkOuterText, Pos('>', LinkOuterText) + 1);

      // Если начальные точки TRLink и TrSel совпадают, то удаляем старый Link,
      // в противном случае в HTML тексте остается старый Link с пустым текстом
        if StartPointsOffset = 0 then Element.outerHTML:=Element.outertext;;

        TRTotal.pasteHTML(TextBeforeLink+LinkOuterText+TextAfterLink);

      end;
    end;
  end;
end;