delphi - página - RichEdit no procesa hipervínculos

hipervinculos en html ejemplos

Question

Quiero que mi RichEdit procese hipervínculos, así que seguí las instrucciones en: http://delphi.about.com/od/vclusing/l/aa111803a.htm

Aquí están los cambios que hice al código:

interface

type
  TProgCorner = class(TForm)
    RichEdit2: TRichEdit;
    RichEdit1: TRichEdit;
    RichEdit3: TRichEdit;
    RichEdit4: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    procedure InitRichEditURLDetection(RE: TRichEdit);
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;

implementation

{$R *.DFM}

uses
  ShellAPI, RichEdit;

const
  AURL_ENABLEURL = 1;
  AURL_ENABLEEAURLS = 8;

procedure TProgCorner.InitRichEditURLDetection(RE: TRichEdit);
var
  mask: LResult;
begin
  mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
  //In the debugger mask is always 1, for all 4 Richedits.
  SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK); 
  //returns 67108865
  SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0);
  //Returns 0 = success (according to MSDN), but no joy.
  //SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEEAURLS, 0); 
  //When uncommented returns -2147024809
  //I don''t think the registration works, but don''t know how to fix this.
end;

procedure TProgCorner.WndProc(var Msg: TMessage);
var
  p: TENLink;
  sURL: string;
  CE: TRichEdit;
begin
  //''normal'' messages do get through here, but...
  if (Msg.Msg = WM_NOTIFY) then begin
    //...the following line is never reached.
    if (PNMHDR(Msg.lParam).code = EN_LINK) then begin
      p:= TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
      if (p.Msg = WM_LBUTTONDOWN) then begin
        try
          CE:= TRichEdit(ProgCorner.ActiveControl);
          SendMessage(CE.Handle, EM_EXSETSEL, 0, LPARAM(@(p.chrg)));
          sURL:= CE.SelText;
          ShellExecute(Handle, ''open'', PChar(sURL), 0, 0, SW_SHOWNORMAL);
        except
          {ignore}
        end;
      end;
    end;
  end;

 inherited;
end;

procedure TProgCorner.FormCreate(Sender: TObject);
begin
  InitRichEditURLDetection(RichEdit1);
  InitRichEditURLDetection(RichEdit2);
  InitRichEditURLDetection(RichEdit3);
  InitRichEditURLDetection(RichEdit4);
  //If I set the text here (and not in the object inspector) 
  //the richedit shows a hyperlink with the ''hand'' cursor.
  //but still no WM_notify message gets received in WndProc.
  RichEdit1.Text:= ''http://www.example.com'';

end;

end.

Sin embargo, los hipervínculos que incorporé a mis RichEditx.Lines usando el inspector de objetos aparecen como texto sin formato (no enlaces) y al hacer clic en ellos no funciona.

Estoy usando Delphi Seattle corriendo en Windows 7 en modo Win32.

¿Qué estoy haciendo mal?

ACTUALIZAR
Usando una combinación de emitir el obsoleto
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0); y configurando RichEditx.Text:= ''http://www.example.com'' manualmente en FormCreate Puedo hacer que Richedit muestre un hipervínculo y un manual.
Sin embargo, el WndProc aún no recibe un mensaje WM_Notify .
El WndProc recibe otros mensajes.

ACTUALIZACIÓN2
En mi afán por simplificar el problema, dejé de lado el hecho de que RichEdit ubica en la parte superior de un Panel . El panel come los mensajes de WM_Notify para que no lleguen al formulario de abajo.

Answer 1

El código que se muestra en tu pregunta funciona perfecto para mí tal como está . A pesar de su reclamo, el formulario WndProc() recibe las notificaciones EN_LINK y lanza las URL EN_LINK , como se esperaba.

Sin embargo, si coloca un RichEdit en otro control principal, como un TPanel , el Formulario ya no recibirá el mensaje WM_NOTIFY . El control padre los recibirá y, como tal, tendrá que subclasificar el control padre en su lugar.

Dicho esto, hay algunas mejoras que se pueden hacer en el código que se muestra:

1. en su manejo EN_LINK , puede reemplazar esto:

   CE := TRichEdit(ProgCorner.ActiveControl);

   con esto en su lugar:

   CE := TRichEdit(FindControl(TWMNotify(Msg).NMHdr.hwndFrom));

   La notificación le indica el HWND del control RichEdit que lo está enviando, y la VCL sabe cómo recuperar un TWinControl de un HWND .

2. use EM_GETTEXTRANGE para recuperar la URL EM_EXSETSEL , en lugar de usar EM_EXSETSEL y SelText (que es una combinación de EM_EXGETSEL y EM_GETTEXTEX ). De esta forma, está utilizando menos mensajes y no tiene que manipular en absoluto el texto seleccionado de RichEdit. La notificación le indica el rango exacto de caracteres para la URL, por lo que puede tomar esos caracteres directamente.

3. necesitas manejar la recreación HWND . El VCL puede recrear un HWND de RichEdit en cualquier momento. Cada vez que se crea un HWND nuevo, debe enviar sus mensajes EM_SETEVENTMASK y EM_AUTOURLDETECT nuevo, de lo contrario perderá su autodetección. La mejor forma de manejar esto es derivar una clase de TRichEdit y anular su método CreateWnd() .

4. Como debe derivar una clase de todos modos, puede hacer que maneje el mensaje CN_NOTIFY la VCL, en lugar de manejar el mensaje WM_NOTIFY original directamente en el WndProc padre. El VCL sabe cómo redirigir un mensaje WM_NOTIFY al control VCL que lo envió. Esto permite que los controles VCL manejen sus propias notificaciones. Por lo tanto, su manejador EN_LINK funcionará sin importar en qué control padre se coloque el RichEdit, no tiene que subclasificar / anular en WndProc() el WndProc() padre WndProc() , y puede usar el puntero Self del RichEdit que está procesando el mensaje al acceder a los miembros de RichEdit, como su propiedad Handle .

Con todo esto dicho, el siguiente código funciona para mí:

unit RichEditUrlTest;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TRichEdit = class(Vcl.ComCtrls.TRichEdit)
  private
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  protected
    procedure CreateWnd; override;
  end;

  TProgCorner = class(TForm)
    RichEdit2: TRichEdit;
    RichEdit1: TRichEdit;
    RichEdit3: TRichEdit;
    RichEdit4: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ProgCorner: TProgCorner;

implementation

{$R *.dfm}

uses
  Winapi.ShellAPI, Winapi.RichEdit;

const
  AURL_ENABLEURL = 1;
  AURL_ENABLEEAURLS = 8;

procedure TRichEdit.CreateWnd;
var
  mask: LResult;
begin
  inherited;
  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0);
end;

procedure TRichEdit.CNNotify(var Message: TWMNotify);
type
  PENLink = ^TENLink;
var
  p: PENLink;
  tr: TEXTRANGE;
  url: array of Char;
begin
  if (Message.NMHdr.code = EN_LINK) then begin
    p := PENLink(Message.NMHdr);
    if (p.Msg = WM_LBUTTONDOWN) then begin
      { optionally, enable this:
      if CheckWin32Version(6, 2) then begin
        // on Windows 8+, returning EN_LINK_DO_DEFAULT directs
        // the RichEdit to perform the default action...
        Message.Result :=  EN_LINK_DO_DEFAULT;
        Exit;
      end;
      }
      try
        SetLength(url, p.chrg.cpMax - p.chrg.cpMin + 1);
        tr.chrg := p.chrg;
        tr.lpstrText := PChar(url);
        SendMessage(Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));
        ShellExecute(Handle, nil, PChar(url), 0, 0, SW_SHOWNORMAL);
      except
        {ignore}
      end;
      Exit;
    end;
  end;
  inherited;
end;

procedure TProgCorner.FormCreate(Sender: TObject);
begin
  RichEdit1.Text:= ''http://www.example.com'';
end;

end.

Answer 2

El problema es que el mensaje WM_Notify nunca alcanza la forma principal.
En cambio, es interceptado por el padre del Richedit (un panel que coloqué allí para fines de alineación).
Erróneamente dejé ese hecho en la pregunta pensando que no importaba.
Dicho esto, lo siguiente funcionó para mí.

Sin embargo, estoy a favor del enfoque arquitectónico más sólido de Remy, y las personas que luchan con este tema deberían probar primero ese enfoque.

En VCL.ComCtrls

  TCustomRichEdit = class(TCustomMemo)
  private  //Why private !?
    procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;

La solución es interponer nuestro propio TRichEdit:

uses   
  ...., RichEdit;

type
  TRichEdit = class(ComCtrls.TRichEdit)
    procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;
  end;  //never mind that its ancester is private, it will still work.

  TProgCorner = class(TForm)

Guardo RichRdits en una matriz, por lo que puedo buscarlos en su HWnd sin tener que realizar un bucle en todos los controles secundarios de mi formulario.

implementation

function TProgCorner.RichEditByHandle(Handle: HWnd): TRichEdit;
var
  i: integer;
begin
  //Keep track of the richedits in an array, initialized on creation.
  for i:= Low(RichEdits) to High(RichEdits) do begin
    if RichEdits[i].Handle = Handle then exit(RichEdits[i]);
  end;
  Result:= nil;
end;

procedure TRichEdit.CNNotify(var Message: TWMNotifyRE);
var
  p: TENLink;
  sURL: string;
  CE: TRichEdit;
begin
  if (Message.NMHdr.code = EN_LINK) then begin
    p:= TENLink(Pointer(TWMNotify(Message).NMHdr)^);
    if (p.Msg = WM_LBUTTONDOWN) then begin
      try
        //CE:= TRichEdit(ProgCorner.ActiveControl);
        //SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
        SendMessage(p.nmhdr.hwndFrom, EM_EXSETSEL, 0, Longint(@(p.chrg)));
        CE:= ProgCorner.RichEditByHandle(p.nmhdr.hwndFrom);
        if assigned(CE) then begin
          sURL:= CE.SelText;
          ShellExecute(Handle, ''open'', PChar(sURL), 0, 0, SW_SHOWNORMAL);
        end;
      except
        {ignore}
      end;
    end;
  end;
  inherited;
end;

Afortunadamente, la interposición de manejadores de mensajes funciona a pesar de que el original se declara privado.

Ahora funciona. como un encanto.

A continuación se encuentra una copia completa de la unidad para referencia futura:

unit ProgCorn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Menus, Clipbrd, LifeConst, Tabnotbk, LifeUtil,
  MyLinkLabel, RichEdit;

type
  TRichEdit = class(ComCtrls.TRichEdit)
    procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;
  end;


  TProgCorner = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    TabbedNotebook1: TTabbedNotebook;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Panel3: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    RichEdit3: TRichEdit;
    RichEdit4: TRichEdit;
    Button2: TButton;
    procedure Copy1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    RichEdits: array[1..4] of TRichEdit;
    procedure InitRichEditURLDetection(RE: TRichEdit);
    function RichEditByHandle(Handle: HWnd): TRichEdit;
  public
    { Public declarations }
  end;

var
  ProgCorner: TProgCorner;


implementation

{$R *.DFM}

uses
  ShellAPI;

const
  AURL_ENABLEEAURLS = 8;
  AURL_ENABLEURL = 1;

procedure TProgCorner.InitRichEditURLDetection(RE: TRichEdit);
var
  mask: NativeInt;
begin
  mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RE.Handle, EM_AUTOURLDETECT, {AURL_ENABLEEAURLS} AURL_ENABLEURL, 0);
end;



procedure TProgCorner.FormCreate(Sender: TObject);
begin
  ProgCorner:= Self;
  InitRichEditURLDetection(RichEdit1);
  InitRichEditURLDetection(RichEdit2);
  InitRichEditURLDetection(RichEdit3);
  InitRichEditURLDetection(RichEdit4);
  RichEdits[1]:= RichEdit1;
  RichEdits[2]:= RichEdit2;
  RichEdits[3]:= RichEdit3;
  RichEdits[4]:= RichEdit4;

  //WordWarp should be set during runtime only, because
  //otherwise the text will not warp, but rather be cut off
  //before run time.
  RichEdit1.Text:= RichEdit1.Text + '' '';
  RichEdit2.Text:= RichEdit2.Text + '' '';
  RichEdit3.Text:= RichEdit3.Text + '' '';
  RichEdit4.Text:= RichEdit4.Text + '' '';
  RichEdit1.WordWrap:= true;
  RichEdit2.WordWrap:= true;
  RichEdit3.WordWrap:= true;
  RichEdit4.WordWrap:= true;
end;

procedure TProgCorner.Copy1Click(Sender: TObject);
var
  ActiveRichEdit: TRichEdit;
begin
  ActiveRichEdit:= TRichEdit(Self.FindComponent(''RichEdit''+
    IntToStr(TabbedNotebook1.PageIndex+1)));
  with ActiveRichEdit do begin
    if SelText <> '''' then Clipboard.AsText:= SelText
    else ClipBoard.AsText:= Lines.Text;
  end; {with}
end;

procedure TProgCorner.PopupMenu1Popup(Sender: TObject);
begin
  Copy1.Enabled:= true;
end;


procedure TProgCorner.Button2Click(Sender: TObject);
begin
  Application.HelpContext(4);
end;

{ TRichEdit }

function TProgCorner.RichEditByHandle(Handle: HWnd): TRichEdit;
var
  i: integer;
begin
  for i:= Low(RichEdits) to High(RichEdits) do begin
    if RichEdits[i].Handle = Handle then exit(RichEdits[i]);
  end;
  Result:= nil;
end;

procedure TRichEdit.CNNotify(var Message: TWMNotifyRE);
var
  p: TENLink;
  sURL: string;
  CE: TRichEdit;
begin
  //if (Message.Msg = WM_NOTIFY) then begin
    if (Message.NMHdr.code = EN_LINK) then begin
      p:= TENLink(Pointer(TWMNotify(Message).NMHdr)^);
      if (p.Msg = WM_LBUTTONDOWN) then begin
        try
          //CE:= TRichEdit(ProgCorner.ActiveControl);
          //SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
          SendMessage(p.nmhdr.hwndFrom, EM_EXSETSEL, 0, Longint(@(p.chrg)));
          CE:= ProgCorner.RichEditByHandle(p.nmhdr.hwndFrom);
          if assigned(CE) then begin
            sURL:= CE.SelText;
            ShellExecute(Handle, ''open'', PChar(sURL), 0, 0, SW_SHOWNORMAL);
          end;
        except
          {ignore}
        end;
      end;
    end;
  //end;
  inherited;
end;

end.