delphi 如何在TRichEdit中处理通用超链接

您需要执行以下操作：

向RichEdit发送EM_SETEVENTMASK消息以启用该ENM_LINK 标志。在创建RichEdit之后，请执行一次此操作，然后在每次RichEdit收到CM_RECREATEWND消息时再次执行此操作。

选择您想要变成链接的所需文本。您可以使用RichEdit的SelStart和SelLength属性，或向RichEdit发送EM_SETSEL或EM_EXSETSEL消息。无论哪种方式，然后向RichEditEM_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.

更多可以查看：https://stackoverflow.com/questions/42532760/adding-true-hyperlink-support-to-trichedit