Обнаружение клика по URL в RichEdit - PullRequest
5 голосов
/ 19 марта 2010

Я пытаюсь обновить RichEdit, чтобы он обнаруживал URL и позволял щелкать по нему, чтобы открыть в браузере. Обнаружение URL легко, я просто использую следующий код из http://www.scalabium.com/faq/dct0146.htm

mask := SendMessage(MNote.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(MNote.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(MNote.Handle, EM_AUTOURLDETECT, Integer(True), 0); 

но вторая часть не работает для меня. Они дают следующий код для захвата сообщения EN_LINK и его обработки:

type
  TForm1 = class(TForm)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;
...

procedure TForm1.WndProc(var Message: TMessage);
var
  p: TENLink;
  strURL: string;
begin
  if (Message.Msg = WM_NOTIFY) then
  begin
    if (PNMHDR(Message.LParam).code = EN_LINK) then
    begin
      p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
      if (p.msg = WM_LBUTTONDOWN) then
      begin
        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, LongInt(@(p.chrg)));
        strURL := RichEdit1.SelText;
        ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
      end
    end
  end;

  inherited;
end;

Когда я запускаю программу, URL-адрес обнаруживается, но нажатие на него ничего не делает. Используя debug, я обнаружил, что Message.Msg = WM_NOTIFY не соответствует действительности, когда я нажимаю на URL. Затем я попытался переопределить WndProc TRichEdit, но результат тот же. Есть предложения?

Ответы [ 3 ]

7 голосов
/ 20 марта 2010

Создайте подкласс свойства WindowProc RichEdit и найдите сообщение CN_NOTIFY, например:

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    PrevRichEditWndProc: TWndMethod;
    procedure RichEditWndProc(var Message: TMessage);
    procedure SetRichEditMasks;
  end; 

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevRichEditWndProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := RichEditWndProc;
  SetRichEditMasks;
end;

procedure TForm1.SetRichEditMasks;
var
  mask: Longint;
begin
  mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0); 
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK); 
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, 1, 0);  
end;

procedure TForm1.RichEditWndProc(var Message: TMessage); 
begin 
  PrevRichEditWndProc(Message);
  case Message.Msg of
    CN_NOTIFY:
      begin
        if (TWMNotify(Message).NMHdr^.code = EN_LINK) then
        begin
          with PENLink(Message.LParam)^ do
          begin
            if (msg = WM_LBUTTONDOWN) then
            begin 
              SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, LongInt(@chrg)); 
              ShellExecute(Handle, 'open', PChar(RichEdit1.SelText), 0, 0, SW_SHOWNORMAL); 
            end;
          end;
        end;
      end;
    CM_RECREATEWND:
      begin
        SetRichEditMasks;
      end;
  end; 
end;
1 голос
/ 30 марта 2011

Для меня это работает, только если отображаемый текст совпадает с основной гиперссылкой.

Я думаю, что моя проблема в том, что нижележащая гиперссылка имеет атрибут CFE_HIDDEN, и поэтому не может быть выбрана EM_EXSETSEL.

Например, если я создаю (в WORD) ссылку с URL-адресом http://www.rubbish.com,, но в которой отображается текст RUBBISH, хотя chrg выделенного текста составляет 11-33, то есть 22 символа - то же самое длина в качестве URL, фактический текст, возвращаемый методом - RUBBISH.

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

HYPERLINK "http://www.rubbish.com" RUBBISH

Из которого я могу извлечь URL на основе chrg.

Это кажется немного неуклюжим ... но это работает. : -)

0 голосов
/ 20 марта 2010

Вы пробовали это с урезанным приложением, чтобы убедиться, что это не что-то другое в вашей программе, вызывающее проблемы? Я следовал инструкциям этого веб-сайта в Delphi 2009, и клики по URL-адресам работали очень хорошо.

...