问题描述
我需要在 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 theENM_LINK
flag. Do this once after the RichEdit has been created, and then do it again every time the RichEdit receives aCM_RECREATEWND
message.
选择您想要变成链接的所需文本.您可以使用 RichEdit 的 SelStart
和 SelLength
属性,或向 RichEdit 发送 EM_SETSEL
或 EM_EXSETSEL
消息.无论哪种方式,然后向 RichEdit 发送 EM_SETCHARFORMAT
带有
CHARFORMAT2
结构以启用对所选文本的
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 的 WordPad 中,名为 MSN 的超链接将包含纯文本
HYPERLINK "http://www.msn.com"MSN
整个链接将具有
CFE_LINK
和 CFE_LINKPROTECTED
字符格式属性,除 MSN 之外的所有链接都将具有 CFE_HIDDEN
属性.
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;
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 添加真正的超链接支持的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!