将真正的超链接支持添加到TRichEdit

Question

将真正的超链接支持添加到TRichEdit

3

我需要TRichEdit中“友好名字超链接”的支持，但我发现所有的解决方案都基于自动URL检测（EM_AUTOURLDETECT），其工作原理是检测用户输入的以www（或http）开头的字符串。

然而我希望在不以www开头的字符串上放置链接，例如：“下载”。

- Gabriel Moraru

你的链接使用了TRichEdit的本机属性，但是我认为你需要做一些更加复杂的事情。你可能在使用错误的控件，但是由于信息不足，很难确定。TRichEdit被设计用作文本编辑器，例如，在这样的控件中，用户如何输入一个非可见的文本比如你所需的呢？如果它是只读的，那么你可能需要使用一种HTML查看器而不是TRichEdit。 - Dsm

2

ITextRange2.SetUrl https://blogs.msdn.microsoft.com/murrays/2009/09/24/richedit-friendly-name-hyperlinks/ - David Heffernan

1

对于旧版本，您将需要使用文章中描述的技术。 - David Heffernan

在RichEdit 4.1中，插入友好名称超链接的唯一方法是读取“相应的RTF” - 这意味着解析整个rtf结构，更改一个链接并将RTF结构“上传”回控件以进行渲染。而且，如果我有多个链接，我必须找出哪个链接被点击了。这是一个不好的hack :) - Gabriel

1

@NAZCA：实际上它确实可以，通过展示如何对超链接点击做出反应并启动所点击的URL。创建友好名称超链接只是关于如何格式化CFE_LINK文本并在EN_LINK通知中解析它的问题。请参见下面我回答的更新部分，其中有一个例子。 - Remy Lebeau

显示剩余2条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Remy Lebeau · Accepted Answer

您需要执行以下操作：

向RichEdit发送EM_SETEVENTMASK消息，以启用ENM_LINK标志。在RichEdit创建后执行一次此操作，然后每次RichEdit接收到CM_RECREATEWND消息时再次执行。
选择要转换为链接的所需文本。您可以使用RichEdit的SelStart和SelLength属性，或者发送RichEdit一个EM_SETSEL或EM_EXSETSEL消息。无论哪种方式，然后发送RichEdit一个EM_SETCHARFORMAT消息，带有一个CHARFORMAT2结构，以在所选文本上启用CFE_LINK效果。
子类化RichEdit的WindowProc属性以处理CN_NOTIFY(EN_LINK)和CM_RECREATEWND消息。当接收到EN_LINK时，您可以使用ShellExecute/Ex()来启动所需的URL。

例如：

unit Unit1;

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
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    PrevRichEditWndProc: TWndMethod;
    procedure InsertHyperLink(const HyperlinkText: string);
    procedure SetRichEditMasks;
    procedure RichEditWndProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Winapi.RichEdit, Winapi.ShellAPI;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevRichEditWndProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := RichEditWndProc;

  SetRichEditMasks;

  RichEdit1.Text := 'Would you like to Download Now?';

  RichEdit1.SelStart := 18;
  RichEdit1.SelLength := 12;    
  InsertHyperLink('Download Now');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertHyperLink('Another Link');
end;

procedure TForm1.InsertHyperLink(const HyperlinkText: string);
var
  Fmt: CHARFORMAT2;
  StartPos: Integer;
begin
  StartPos := RichEdit1.SelStart;
  RichEdit1.SelText := HyperlinkText;

  RichEdit1.SelStart := StartPos;
  RichEdit1.SelLength := Length(HyperlinkText);

  FillChar(Fmt, SizeOf(Fmt), 0);
  Fmt.cbSize := SizeOf(Fmt);
  Fmt.dwMask := CFM_LINK;
  Fmt.dwEffects := CFE_LINK;

  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));

  RichEdit1.SelStart := StartPos + Length(HyperlinkText);
  RichEdit1.SelLength := 0;
end;

procedure TForm1.SetRichEditMasks;
var
  Mask: DWORD;
begin
  Mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, Mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, 1, 0);
end;

procedure TForm1.RichEditWndProc(var Message: TMessage);
type
  PENLINK = ^ENLINK;
var
  tr: TEXTRANGE;
  str: string;
  p: PENLINK;
begin
  PrevRichEditWndProc(Message);

  case Message.Msg of
    CN_NOTIFY: begin
     if TWMNotify(Message).NMHdr.code = EN_LINK then
      begin
        P := PENLINK(Message.LParam);
        if p.msg = WM_LBUTTONUP then
        begin
          SetLength(str, p.chrg.cpMax - p.chrg.cpMin);
          tr.chrg := p.chrg;
          tr.lpstrText := PChar(str);
          SendMessage(RichEdit1.Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));

          if str = 'Download Now' then
          begin
            ShellExecute(Handle, nil, 'http://www.SomeSite.com/download', nil, nil, SW_SHOWDEFAULT);
          end
          else if str = 'Another Link' then
          begin
            // do something else
          end;
        end;
      end;
    end;

    CM_RECREATEWND: begin
      SetRichEditMasks;
    end;
  end;
end;

end.

更新: 根据MSDN:

RichEdit友好名称超链接

In RichEdit, the hyperlink field entity is represented by character formatting effects, as contrasted to delimiters which are used to structure math objects. As such, these hyperlinks cannot be nested, although in RichEdit 5.0 and later they can be adjacent to one another. The whole hyperlink has the character formatting effects of CFE_LINK and CFE_LINKPROTECTED, while autoURLs only have the CFE_LINK attribute. The CFE_LINKPROTECTED is included for the former so that the autoURL scanner skips over friendly name links. The instruction part, i.e., the URL, has the CFE_HIDDEN attribute as well, since it’s not supposed to be displayed. The URL itself is enclosed in ASCII double quotes and preceded by the string “HYPERLINK “. Since CFE_HIDDEN plays an integral role in friendly name hyperlinks, it cannot be used in the name.

For example, in WordPad, which uses RichEdit, a hyperlink with the name MSN would have the plain text
HYPERLINK “http://www.msn.com”MSN
The whole link would have CFE_LINK and CFE_LINKPROTECTED character formatting attributes and all but the MSN would have the CFE_HIDDEN attribute.

这在代码中很容易模拟：

procedure TForm1.FormCreate(Sender: TObject);
begin
  ...
  RichEdit1.Text := 'Would you like to Download Now?';

  RichEdit1.SelStart := 18;
  RichEdit1.SelLength := 12;    
  InsertHyperLink('Download Now', 'http://www.SomeSite.com/downloads');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertHyperLink('A Text Link');
end;

procedure TForm1.InsertHyperLink(const HyperlinkText: string; const HyperlinkURL: string = '');
var
  HyperlinkPrefix, FullHyperlink: string;
  Fmt: CHARFORMAT2;
  StartPos: Integer;
begin
  if HyperlinkURL <> '' then
  begin
    HyperlinkPrefix := Format('HYPERLINK "%s"', [HyperlinkURL]);
    FullHyperlink := HyperlinkPrefix + HyperlinkText;
  end else begin
    FullHyperlink := HyperlinkText;
  end;

  StartPos := RichEdit1.SelStart;
  RichEdit1.SelText := FullHyperlink;

  RichEdit1.SelStart := StartPos;
  RichEdit1.SelLength := Length(FullHyperlink);

  FillChar(Fmt, SizeOf(Fmt), 0);
  Fmt.cbSize := SizeOf(Fmt);
  Fmt.dwMask := CFM_LINK;
  Fmt.dwEffects := CFE_LINK;
  if HyperlinkURL <> '' then
  begin
    // per MSDN: "RichEdit doesn’t allow the CFE_LINKPROTECTED attribute to be
    // set directly by programs. Maybe it will allow it someday after enough
    // testing is completed to ensure that things cannot go awry"...
    //
    {
    Fmt.dwMask := Fmt.dwMask or CFM_LINKPROTECTED;
    Fmt.dwEffects := Fmt.dwEffects or CFE_LINKPROTECTED;
    }
  end;

  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));

  if HyperlinkURL <> '' then
  begin
    RichEdit1.SelStart := StartPos;
    RichEdit1.SelLength := Length(HyperlinkPrefix);

    FillChar(Fmt, SizeOf(Fmt), 0);
    Fmt.cbSize := SizeOf(Fmt);
    Fmt.dwMask := CFM_HIDDEN;
    Fmt.dwEffects := CFE_HIDDEN;

    SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
  end;

  RichEdit1.SelStart := StartPos + Length(FullHyperlink);
  RichEdit1.SelLength := 0;
end;

然后在EN_LINK通知中处理，通过解析点击的超链接文本：

uses
  ..., System.StrUtils;

...

SendMessage(RichEdit1.Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));

// Per MSDN: "The ENLINK notification structure contains a CHARRANGE with
// the start and end character positions of the actual URL (IRI, file path
// name, email address, etc.) that typically appears in a browser URL
// window. This doesn’t include the “HYPERLINK ” string nor the quotes in
// the hidden part. For the MSN link above, it identifies only the
// http://www.msn.com characters in the backing store."
//
// However, without the CFM_LINKPROTECTED flag, the CHARRANGE will report
// the positions of the entire "HYPERLINK ..." string instead, so just strip
// off what is not needed...
//
if StartsText('HYPERLINK "', str) then
begin
  Delete(str, 1, 11);
  Delete(str, Pos('"', str), MaxInt);
end;

if (str is a URL) then begin
  ShellExecute(Handle, nil, PChar(str), nil, nil, SW_SHOWDEFAULT);
end
else begin
  // do something else
end;