RichEdit 不处理超链接

Question

我想让我的 RichEdit 处理超链接，所以我按照以下说明操作：http://delphi.about.com/od/vclusing/l/aa111803a.htm

以下是我对代码所做的更改：

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.

然而，我使用对象检查器嵌入到我的 RichEditx.Lines 中的超链接显示为纯文本（不是链接）并且点击它们不起作用。

我在 Windows 7 上以 Win32 模式使用 Delphi 西雅图运行。

我做错了什么？

更新
结合使用已弃用的
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0); 并在 FormCreate 中手动设置 RichEditx.Text:= 'http://www.example.com' 我可以让 Richedit 显示超链接和手形光标。
但是 WndProc 仍然没有收到 WM_Notify 消息。
WndProc 确实接收到其他消息。

更新2
为了简化问题，我忽略了 RichEdit 位于 Panel 之上的事实。面板吃掉 WM_Notify 消息，因此它们不会到达下面的表格。

Answer 1

问题是 WM_Notify 消息从未到达主窗体。
相反，它被 Richedit 的父级拦截（我放置在那里用于对齐目的的面板）。
我在问题中错误地遗漏了这个事实，认为这无关紧要。
那就是说以下对我有用。

不过，我强烈赞成 Remy 在架构上更合理的方法，遇到这个问题的人应该首先尝试这种方法。

在VCL.ComCtrls

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

解决方案是插入我们自己的 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)

我将 RichRdits 存储在一个数组中，这样我就可以通过 HWnd 查找它们，而不必遍历我表单的所有子控件。

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;

幸运的是，即使原始消息被声明为私有，消息处理程序的插入也能正常工作。

现在可以了。就像一个魅力。

以下是单元的完整副本以供将来参考：

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.

Answer 2

您问题中显示的代码对我来说非常完美as-is。尽管您声称，表单的 WndProc() 确实收到了 EN_LINK 通知并按预期启动了点击的 URL。

但是，如果将 RichEdit 放在另一个 parent 控件上，例如 TPanel，则表单将不再接收 WM_NOTIFY 消息。 parent 控件将接收它们，因此您必须将 class 改为 parent 控件。

也就是说，可以对所示代码进行一些改进：

在您的 EN_LINK 处理中，您可以替换为：
```
CE := TRichEdit(ProgCorner.ActiveControl);
```
用这个代替：
```
CE := TRichEdit(FindControl(TWMNotify(Msg).NMHdr.hwndFrom));
```
通知告诉您发送它的 RichEdit 控件的 HWND，VCL 知道如何从 HWND.
中检索 TWinControl
使用EM_GETTEXTRANGE检索点击的URL，而不是使用EM_EXSETSEL和SelText（这是[=24=的组合） ] 和 EM_GETTEXTEX)。这样，您使用的消息就更少了，而且根本不必操作 RichEdit 的选定文本。通知会告诉您 URL 的确切字符范围，因此您可以直接获取这些字符。
您需要处理 HWND 娱乐活动。 VCL 可以随时重新创建 RichEdit 的 HWND。每次创建新的 HWND 时，您都必须再次发送 EM_SETEVENTMASK 和 EM_AUTOURLDETECT 消息，否则您将丢失 auto-detection。处理此问题的最佳方法是从 TRichEdit 派生一个 class 并覆盖其 CreateWnd() 方法。
因为你无论如何都要派生一个class，你可以让它处理VCL的CN_NOTIFY消息，而不是直接处理原始的WM_NOTIFY消息parent 的 WndProc。 VCL 知道如何将 WM_NOTIFY 消息重定向到发送它的 VCL 控件。这允许 VCL 控件处理它们自己的通知。因此，无论 RichEdit 放在什么 parent 控件上，您的 EN_LINK 处理程序都可以工作，您不必 subclass/override parent 的 WndProc()完全没有，您可以在访问 RichEdit 的成员时使用正在处理消息的 RichEdit 的 Self 指针，例如它的 Handle 属性.

综上所述，以下代码对我有用：

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.

RichEdit 不处理超链接

RichEdit does not process hyperlinks

delphi

hyperlink

richedit