unit RichEditURL;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls,
ComCtrls, ExtCtrls, RichEdit;
type
TURLClickEvent =
procedure(Sender :TObject;
const URL:
string)
of object;
TRichEditURL =
class(TRichEdit)
private
FOnURLClick: TURLClickEvent;
procedure CNNotify(
var Msg: TWMNotify);
message CN_NOTIFY;
protected
procedure DoURLClick (
const URL :
string);
procedure CreateWnd;
override;
published
property OnURLClick : TURLClickEvent
read FOnURLClick
write FOnURLClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
delphi.about.com', [TRichEditURL]);
end;
{ TRichEditURL }
procedure TRichEditURL.DoURLClick(
const URL :
string);
begin
if Assigned(FOnURLClick)
then OnURLClick(Self,
URL);
end;
(*DoURLClick*)
procedure TRichEditURL.CNNotify(
var Msg: TWMNotify);
var
p: TENLink;
sURL:
string;
begin
if (Msg.NMHdr^.code = EN_LINK)
then
begin
p := TENLink(Pointer(Msg.NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN)
then
begin
try
SendMessage(
Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
sURL := SelText;
DoURLClick(sURL);
except
end;
end;
end;
inherited;
end;
(*CNNotify*)
procedure TRichEditURL.CreateWnd;
var
mask: Word;
begin
inherited CreateWnd;
SendMessage(
Handle, EM_AUTOURLDETECT,1, 0);
mask := SendMessage(
Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(
Handle, EM_SETEVENTMASK, 0, mask
or ENM_LINK);
end;
(*CreateWnd*)
end.
(* RichEditURL.pas *)
{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
[url]http://delphi.about.com[/url]
email: [email]delphi.guide@about.com[/email]
free newsletter: [url]http://delphi.about.com/library/blnewsletter.htm[/url]
forum: [url]http://forums.about.com/ab-delphi/start/[/url]
********************************************
}