为 TRichEdit 添加真正的超链接支持 [英] Adding true hyperlink support to TRichEdit

查看：33 发布时间：2021/12/13 23:50:25 html delphi browser delphi-xe7 trichedit

本文介绍了为 TRichEdit 添加真正的超链接支持的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我需要在 TRichEdit 中支持友好名称超链接"，我发现的所有解决方案都基于 autoURLs (EM_AUTOURLDETECT)，它通过检测用户输入的以 www(或 http)开头的字符串来工作.

I need support for "friendly name hyperlink" in TRichEdit and all solutions I have found are based on autoURLs (EM_AUTOURLDETECT) which works by detecting strings entered by user that start with www (or http).

但我想在不以 www 开头的字符串上放置链接.示例:下载".

But I want to place links on strings that does not start with www. Example: 'Download'.

推荐答案

您需要做到以下几点:

向 RichEdit 发送 EM_SETEVENTMASK 消息以启用 ENM_LINK 标志.创建 RichEdit 后执行一次，然后每次 RichEdit 收到 CM_RECREATEWND 消息时再执行一次.

send the RichEdit an EM_SETEVENTMASK message to enable the ENM_LINK flag. Do this once after the RichEdit has been created, and then do it again every time the RichEdit receives a CM_RECREATEWND message.

选择您想要变成链接的所需文本.您可以使用 RichEdit 的 SelStart 和 SelLength 属性，或向 RichEdit 发送 EM_SETSEL 或 EM_EXSETSEL 消息.无论哪种方式，然后向 RichEdit 发送 EM_SETCHARFORMAT带有CHARFORMAT2<的消息/code> 结构以启用对所选文本的 CFE_LINK 效果.


select the desired text you want to turn into a link. You can use the RichEdit's SelStart and SelLength properties, or send the RichEdit an EM_SETSEL or EM_EXSETSEL message.  Either way, then send the RichEdit an EM_SETCHARFORMAT message with a CHARFORMAT2 struct to enable the CFE_LINK effect on the selected text.
继承 RichEdit 的 WindowProc 属性以处理 CN_NOTIFY(EN_LINK) 和 CM_RECREATEWND 消息.收到EN_LINK后，您可以使用ShellExecute/Ex()来启动所需的URL.
subclass the RichEdit's WindowProc property to handle CN_NOTIFY(EN_LINK) and CM_RECREATEWND messages.  When EN_LINK is received, you can use ShellExecute/Ex() to launch the desired 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 友好名称超链接

在 RichEdit 中，超链接字段实体由字符格式效果表示，与用于构造数学对象的分隔符形成对比.因此，这些超链接不能嵌套，尽管在 RichEdit 5.0 和更高版本中它们可以彼此相邻.整个超链接具有CFE_LINK和CFE_LINKPROTECTED的字符格式化效果，而autoURLs只有CFE_LINK属性.CFE_LINKPROTECTED 包含在前者中，以便 autoURL 扫描器跳过友好名称链接.指令部分，即 URL，也有 CFE_HIDDEN 属性，因为它不应该被显示.URL 本身用 ASCII 双引号括起来，并以字符串 HYPERLINK" 开头.由于 CFE_HIDDEN 在友好名称超链接中起着不可或缺的作用，因此不能在名称中使用.

  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.
例如，在使用 RichEdit 的 WordPad 中，名为 MSN 的超链接将包含纯文本
For example, in WordPad, which uses RichEdit, a hyperlink with the name MSN would have the plain text
HYPERLINK "http://www.msn.com"MSN

整个链接将具有 CFE_LINK 和 CFE_LINKPROTECTED 字符格式属性，除 MSN 之外的所有链接都将具有 CFE_HIDDEN 属性.
The whole link would have CFE_LINK and CFE_LINKPROTECTED character formatting attributes and all but the MSN would have the CFE_HIDDEN attribute.
这可以在代码中轻松模拟:
This can be simulated easily in code:
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通知中处理:
And then handled in the EN_LINK notification by parsing the clicked hyperlink text:
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;


                        这篇关于为 TRichEdit 添加真正的超链接支持的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！


                    
                        查看全文


        
            



        
        
            相关文章
            
                    
                        
                            为TRichEdit添加真正的超链接支持;
                        
                    
                    
                        
                            TRichEdit是否支持Unicode？;
                        
                    
                    
                        
                            Python matlplotlib 为文本添加超链接;
                        
                    
                    
                        
                            NetworkX：是否为每个节点添加超链接？;
                        
                    
                    
                        
                            为 Winforms DataGrid 控件添加超链接列;
                        
                    
                    
                        
                            动态为HTML表添加超链接控件;
                        
                    
                    
                        
                            如何添加超链接;
                        
                    
                    
                        
                            关于添加超链接;
                        
                    
                    
                        
                            DocX库添加超链接;
                        
                    
                    
                        
                            如何添加超链接到网格和我希望从Sqldatabase添加URL的超链接;
                        
                    
                    
                        
                            动态地为gridview中的超链接添加资源;
                        
                    
                    
                        
                            超链接内的超链接;
                        
                    
                    
                        
                            在动态添加GridView的超链接;
                        
                    
                    
                        
                            向闪亮图添加超链接;
                        
                    
                    
                        
                            在CSV中添加超链接;
                        
                    
                    
                        
                            Excel条件超链接为两个条件输出超链接;
                        
                    
                    
                        
                            如何添加永久链接/超链接到页脚（wordpress）？;
                        
                    
                    
                        
                            制作自己的图标并添加超链接;
                        
                    
                    
                        
                            如何在JLabel中添加超链接？;
                        
                    
                    
                        
                            如何在JLabel中添加超链接;
                        
                    
                    
                        
                            在网格视图中添加超链接;
                        
                    
                    
                        
                            将超链接添加到gridview;
                        
                    
                    
                        
                            将超链接添加到ValidationSummary;
                        
                    
                    
                        
                            如何在图表中添加超链接;
                        
                    
                    
                        
                            在GWT celltable中添加超链接;

为 TRichEdit 添加真正的超链接支持 [英] Adding true hyperlink support to TRichEdit

问题描述

推荐答案

相关文章

前端开发最新文章

热门教程

热门工具

登录关闭

为 TRichEdit 添加真正的超链接支持 [英] Adding true hyperlink support to TRichEdit

问题描述

推荐答案

相关文章

前端开发最新文章

热门教程

热门工具

登录 关闭

登录关闭