Adding true hyperlink support to TRichEdit - html

Question

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).
But I want to place links on strings that does not start with www. Example: 'Download'.

Answer 1

You need to do the following:
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.
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.
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.
For example:
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.
Update: Per MSDN:
RichEdit Friendly Name Hyperlinks
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.
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;