delphi - 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 Seattle。

我做错了什么？

更新
使用发布已弃用的组合
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0); 并在 中手动设置 RichEditx.Text:= 'http://www.example.com' >FormCreate 我可以让 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;

幸运的是，即使原始消息处理程序被声明为私有(private)，消息处理程序的插入仍然有效。

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

以下是该单元的完整副本，以供将来引用:

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.