Detectar hacer clic en URL en RichEdit

Question

Estoy tratando de actualizar RichEdit para que detecte la URL y permite hacer clic en ella para abrir en el navegador. La detección de URL es fácil, sólo tiene que utilizar el siguiente código de 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); 

pero la segunda parte no funciona para mí. Ellos dan el siguiente código para capturar el mensaje EN_LINK y procesarla:

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; 

Cuando ejecuto el programa, se detecta URL, pero al hacer clic en él no hace nada. Al utilizar la depuración descubrí que Message.Msg = WM_NOTIFY no es verdadero cuando hago clic en la URL. Luego intenté anular el WndProc de TRichEdit, pero el resultado es el mismo. ¿Alguna sugerencia?

Answer 1

Subclase propiedad y WindowProc del RichEdit busque el mensaje CN_NOTIFY, por ejemplo:

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; 

Answer 2

¿Has probado con una aplicación reducida para asegurarte de que no sea otra cosa en tu programa que cause problemas? Seguí los pasos de ese sitio web en Delphi 2009 y hacer clic en las URL funcionó bien.

Answer 3

Para mí, sólo funciona si el texto que se muestra es el mismo texto que el hipervínculo subyacente.

Creo que mi problema es que el hipervínculo subyacente tiene el atributo CFE_HIDDEN, por lo que no puede ser seleccionado por EM_EXSETSEL.

Como ejemplo, si creo (en WORD) un enlace con la url http://www.rubbish.com, pero que muestra el texto RUBBISH, aunque el chrg del texto seleccionado es 11-33 que es de 22 caracteres, la misma longitud que el URL, el texto real devuelto por el método es RUBBISH.

Sin embargo, he descubierto que si uso WM_GETTEXT, la totalidad del enlace se devuelve:

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

de la que puede extraer la URL basada en el chrg.

Se siente un poco torpe ... pero funciona. :-)