1. 技术文章
  2. RichEdit does not process hyperlinks

RichEdit does not process hyperlinks

由 核能气质少年 提交于 2020-01-02 11:05:43

问题


I want my RichEdit to process hyperlinks, so I followed the instructions on: http://delphi.about.com/od/vclusing/l/aa111803a.htm

Here are the changes I made to the code:

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.

However the hyperlinks that I embedded into my RichEditx.Lines using the object inspector show up as plain text (not links) and clicking on them does not work.

I'm using Delphi Seattle running on Windows 7 in Win32 mode.

What am I doing wrong?

UPDATE
Using a combination of issuing the deprecated
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0); and setting the RichEditx.Text:= 'http://www.example.com' manually in FormCreate I am able to have the Richedit display a hyperlink and handcursor.
However the WndProc still does not receive a WM_Notify message.
The WndProc does receive other messages.

UPDATE2
In my eagerness to simplify the issue I left out the fact that the RichEdit sits on top of a Panel. The panel eats the WM_Notify messages so they don't reach the form underneigh.


回答1:


The code shown in your question works perfect for me as-is. Despite your claim, the Form's WndProc() does receive the EN_LINK notifications and launches the clicked URLs, as expected.

However, if you place a RichEdit on another parent control, like a TPanel, then the Form will not receive the WM_NOTIFY message anymore. The parent control will receive them, and as such you will have to subclass that parent control instead.

That being said, there are a few improvements that can be made to the code shown:

  1. in your EN_LINK handling, you can replace this:

    CE := TRichEdit(ProgCorner.ActiveControl);

    with this instead:

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

    The notification tells you the HWND of the RichEdit control that is sending it, and the VCL knows how to retrieve a TWinControl from an HWND.

  2. use EM_GETTEXTRANGE to retrieve the clicked URL, instead of using EM_EXSETSEL and SelText (which is a combination of EM_EXGETSEL and EM_GETTEXTEX). This way, you are using fewer messages, and don't have to manipulate the RichEdit's selected text at all. The notification tells you the exact range of characters for the URL, so you can just grab those characters directly.

  3. you need to handle HWND recreation. The VCL may recreate a RichEdit's HWND at any time. Every time a new HWND is created, you have to send your EM_SETEVENTMASK and EM_AUTOURLDETECT messages again, otherwise you will lose your auto-detection. The best way to handle this is to derive a class from TRichEdit and override its CreateWnd() method.

  4. Since you have to derive a class anyway, you can have it handle the VCL's CN_NOTIFY message, instead of handling the original WM_NOTIFY message directly in the parent's WndProc. The VCL knows how to redirect a WM_NOTIFY message to the VCL control that sent it. This allows VCL controls to handle their own notifications. Thus, your EN_LINK handler will work no matter what parent control the RichEdit is placed on, you don't have to subclass/override the parent's WndProc() at all, and you can use the Self pointer of the RichEdit that is processing the message when accessing members of the RichEdit, such as its Handle property.

With all of that said, the following code works for me:

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.



回答2:


The problem is that the WM_Notify message never reaches the mainform.
Instead it gets intercepted by the parent of the Richedit (A panel I placed in there for alignment purposes).
I mistakenly left out that fact in the question thinking it did not matter.
That said the following worked for me.

However I strongly favor Remy's architecturally more sound approach, and people struggling with this issue should try that approach first.

In VCL.ComCtrls 

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

The solution is to interpose our own 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)

I store the RichRdits in an array, so I can look them up by their HWnd without having to loop though all childcontrols of my form. 

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;

Luckily the interposing of message handlers works even though the original is declared private.

Now it works. like a charm.

Below is a full copy of the unit for future reference:

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.


来源：https://stackoverflow.com/questions/37790845/richedit-does-not-process-hyperlinks

标签
Delphi
hyperlink
richedit
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!