Cześć
Czy udało się komuś zmusić RichEdit do obsługi innych schematów URL niż te standardowe ? Chciałbym aby RichEdit traktował jako linki nie tylko:
http://onet.pl
ale też na przykład
test://costam.costam/
Próbowałem rejestrować "test" w HKEY_CLASSES_ROOT
ale nic to nie dało.
W dokumentacji niby coś o tym jest:
https://docs.microsoft.com/en-us/windows/win32/controls/em-autourldetect
lParam
This parameter determines the URL schemes recognized if AURL_ENABLEURL is active. If lParam is NULL, the default scheme name list is used (see Remarks).
a w tych Remarksach jest że są to:
callto, file, ftp, gopher, http, https, mailto, news, notes, nntp, onenote, outlook, prospero, tel, telnet, wais, webcal
ale, dalej pisze że:
Alternatively, lParam can point to a null-terminated string consisting of up to 50 colon-terminated scheme names that supersede the default scheme name list. For example, the string could be "newsftp".
Tylko jak to zrobić, jak próbuję tak:
procedure TRichEdit.CreateWnd;
var
mMask: Longint;
schemes : String;
begin
inherited CreateWnd;
mMask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_LINK;
schemes := 'test:http:';
SendMessage(Handle, EM_SETEVENTMASK, 0, mMask);
SendMessage(Handle, EM_AUTOURLDETECT, WParam(1) {AURL_ENABLEURL}, LParam(0)); // <= to działa, zwraca 0
SendMessage(Handle, EM_AUTOURLDETECT, WParam(1) {AURL_ENABLEURL}, LParam(PChar(schemes))); // <= to nie działa, zwraca -2147024809
end;
To nie działa, SendMessage zwraca -2147024809
cały kod:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, RichEdit;
type
TRichEditURLClick = procedure (Sender: TObject; aURL: string) of object;
TRichEdit = class (ComCtrls.TRichEdit)
private
{ Private declarations }
FOnURLClick: TRichEditURLClick;
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure CN_NOTIFY(var Msg: TWMNotify); message CN_NOTIFY;
public
{ Public declarations }
published
{ Published declarations }
property OnURLClick: TRichEditURLClick read FOnURLClick write FOnURLClick;
end;
TForm1 = class(TForm)
RichEdit1: TRichEdit;
private
{ Private declarations }
public
{ Public declarations }
procedure OnClickUrl(Sender: TObject; aURL: string);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TRichEdit }
procedure TRichEdit.CN_NOTIFY(var Msg: TWMNotify);
var
en_link: TENLINK;
text_range: TTextRangeA;
ch_range: TCharRange;
begin
Case Msg.NMHdr^.code of
$070b:
Begin
en_link := TENLink((Pointer(Msg.NMHdr))^);
Case en_link.msg of
WM_LBUTTONUP :
Begin
ch_range := en_link.chrg;
text_range.chrg.cpMin := ch_range.cpMin;
text_range.chrg.cpMax := ch_range.cpMax;
text_range.lpstrText := StrAlloc(2*(ch_range.cpMax - ch_range.cpMin) + 1);
SendMessage(Handle, EM_GETTEXTRANGE, 0, LongInt(@text_range));
If Assigned(FOnURLClick) then
FOnURLClick(Self, PWideChar(text_range.lpstrText));
End;
End;
End
else
inherited;
end;
end;
procedure TRichEdit.CreateWnd;
var
mMask: Longint;
schemes : String;
begin
inherited CreateWnd;
mMask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_LINK;
schemes := 'test:http:';
SendMessage(Handle, EM_SETEVENTMASK, 0, mMask);
SendMessage(Handle, EM_AUTOURLDETECT, WParam(1) {AURL_ENABLEURL}, LParam(0)); // <= to działa, zwraca 0
SendMessage(Handle, EM_AUTOURLDETECT, WParam(1) {AURL_ENABLEURL}, LParam(PChar(schemes))); // <= to nie działa, zwraca -2147024809
end;
{ TForm1 }
procedure TForm1.OnClickUrl(Sender: TObject; aURL: string);
begin
ShowMessage(aUrl);
end;
end.