RichEdit不处理超链接

时间:2016-06-13 13:16:11

标签: delphi hyperlink richedit

我希望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中的超链接显示为纯文本(不是链接),单击它们不起作用。

我正在使用在Win32模式下在Windows 7上运行的Delphi Seattle。

我做错了什么?

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

UPDATE2
在我急于简化问题的过程中,我忽略了RichEdit位于Panel之上的事实。该面板会播放WM_Notify消息,因此他们无法访问下面的表单。

2 个答案:

答案 0 :(得分:5)

问题是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.

答案 1 :(得分:2)

您问题中显示的代码非常适合我 as-is 。尽管您提出了索赔,但表单WndProc()确实会收到EN_LINK次通知,并按预期启动点击后的网址。

但是,如果您将RichEdit放在另一个父控件上,例如TPanel,则表单将不再收到WM_NOTIFY消息。父控件将接收它们,因此您必须继承该父控件的子类。

话虽如此,可以对显示的代码进行一些改进:

  1. EN_LINK处理中,您可以将其替换为:

    CE := TRichEdit(ProgCorner.ActiveControl);
    

    代之以:

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

    通知会告诉您发送它的RichEdit控件的HWND,并且VCL知道如何从TWinControl检索HWND

  2. 使用EM_GETTEXTRANGE检索点击的网址,而不是使用EM_EXSETSELSelTextEM_EXGETSELEM_GETTEXTEX的组合) 。这样,您使用的邮件就更少,并且根本不必操纵RichEdit的所选文本。该通知会告诉您URL的确切字符范围,因此您可以直接获取这些字符。

  3. 您需要处理HWND娱乐活动。 VCL 可以随时重新创建RichEdit HWND。每次创建新的HWND时,您都必须再次发送EM_SETEVENTMASKEM_AUTOURLDETECT条消息,否则您将失去自动检测功能。处理此问题的最佳方法是从TRichEdit派生一个类并覆盖其CreateWnd()方法。

  4. 由于您无论如何必须派生一个类,您可以让它处理VCL的CN_NOTIFY消息,而不是直接在父母&#39中处理原始的WM_NOTIFY消息; s WndProc。 VCL知道如何将WM_NOTIFY消息重定向到发送它的VCL控件。这允许VCL控件处理自己的通知。因此,无论RichEdit放置在哪个父级控件上,您的EN_LINK处理程序都会正常工作,您根本不必子类化/覆盖父级WndProc(),您可以使用在访问RichEdit成员时处理消息的RichEdit的Self指针,例如Handle属性。

  5. 总而言之,以下代码适用于我:

    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.