为TRichEdit添加真正的超链接支持 [英] Adding true hyperlink support to TRichEdit
问题描述
我需要在TRichEdit中支持友好名称超链接,而我发现的所有解决方案均基于autoURL( 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发送 带有消息>
结构可对所选文本启用 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中,超链接字段实体由字符格式表示与用于构造数学对象的定界符相反。这样,尽管在RichEdit 5.0及更高版本中它们可以彼此相邻,但是这些嵌套的超链接不能嵌套。整个超链接具有
CFE_LINK
和CFE_LINKPROTECTED
的字符格式效果,而autoURL仅具有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
andCFE_LINKPROTECTED
, while autoURLs only have theCFE_LINK
attribute. TheCFE_LINKPROTECTED
is included for the former so that the autoURL scanner skips over friendly name links. The instruction part, i.e., the URL, has theCFE_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 "
. SinceCFE_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屋!