Detect click on URL in RichEdit

谁说我不能喝 提交于 2019-11-30 14:52:49

Subclass the RichEdit's WindowProc property and look for the CN_NOTIFY message, for example:

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;

For me, it only works if the displayed text is the same text as the underlying hyperlink.

I think my problem is that the underlying hyperlink has the attribute CFE_HIDDEN, and so can't be selected by EM_EXSETSEL.

As an example, if I create (in WORD) a link with the url http://www.rubbish.com, but which displays the text RUBBISH, although the chrg of the selected text is 11-33 which is 22 characters - the same length as the URL, the actual text returned by the method is RUBBISH.

However, I've discovered that if I use WM_GETTEXT, the whole of the link is returned:

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

From which I can extract the URL based on the chrg.

It feels a little clumsy... but it works. :-)

Have you tried it with a stripped down application to make sure it isn't something else in your program causing problems? I followed the steps from that website in Delphi 2009 and clicking URLs worked just fine.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!