До внесения в его исходник нескольких функций - он инсталлился на панельку. Теперь - нет, не смотря на то, что в реестре он присутствует (в Pallete)
Код:
unit sRichEditURL;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls,
ComCtrls, ExtCtrls, sRichEdit, RichEdit, Graphics;
type
TURLClickEvent = procedure(Sender :TObject; const URL: string) of object;
TsRichEditURL = class(TsRichEdit)
private
FOnURLClick: TURLClickEvent;
MenuOpened: boolean;
procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
protected
procedure DoURLClick (const URL : string);
procedure DoContextPopup(const MousePos: TPoint; Handled: boolean);
procedure WMCommand(Msg: TWMCommand);
procedure WMSetCursor(Message: TWMSetCursor);
procedure WMWindowPosChanging(Message: TWMWindowPosMsg);
procedure WMWindowPosChanged(Message: TWMWindowPosMsg);
procedure Resize();
procedure CreateWnd; override;
public
procedure AddText(Text: string; AFont: TFont);
function FreezeRedraw(): integer;
function UnFreezeRedraw(): integer;
function IsScrollEnd(): boolean;
procedure SetLink();
published
property OnURLClick : TURLClickEvent read FOnURLClick write FOnURLClick;
end;
procedure Register;
var
RedrawCounter: integer;
DefPopup: HMENU;
FPinEnd, ReszEnd: boolean;
const
EM_GETSCROLLPOS = WM_USER + 221;
EM_SETSCROLLPOS = WM_USER + 222;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TsRichEditURL]);
end;
{ Scroll }
function TsRichEditURL.FreezeRedraw(): integer;
begin
SendMessage(Handle, WM_SETREDRAW, 0, 0);
Inc(RedrawCounter);
result := RedrawCounter;
end;
{ ______ часть кода вырезана _______ }
procedure TsRichEditURL.WMCommand(Msg: TWMCommand);
begin
case Msg.ItemID of
wm_undo: undo();
wm_copy: copytoclipboard();
wm_cut: cuttoclipboard();
wm_clear: clearselection();
wm_paste: pastefromclipboard();
em_setsel: selectall();
end;
Dispatch(Msg);
end;
{ *Scroll* }
{ TRichEditURL }
procedure TsRichEditURL.DoURLClick(const URL : string);
begin
if Assigned(FOnURLClick) then OnURLClick(Self, URL);
end; (*DoURLClick*)
procedure TsRichEditURL.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 TsRichEditURL.WMWindowPosChanging(Message: TWMWindowPosMsg);
begin
if FPinEnd then ReszEnd:=IsScrollEnd();
if (ReszEnd and FPinEnd) then PostMessage(Handle, WM_VSCROLL, SB_BOTTOM, 0);
Dispatch(Message);
end;
procedure TsRichEditURL.WMWindowPosChanged(Message: TWMWindowPosMsg);
begin
Dispatch(Message);
end;
procedure TsRichEditURL.Resize();
begin
Resize();
end;
procedure TsRichEditURL.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*)
procedure TsRichEditURL.AddText(Text: string; AFont: TFont);
var OldSS, OldSL: integer;
begin
if AFont = nil then AFont := Font;
OldSS := SelStart;
OldSL := SelLength;
SelStart := GetTextLen();
SelAttributes.Assign(AFont);
SelText := Text;
SelStart := OldSS;
SelLength := OldSL;
end;
procedure TsRichEditURL.SetLink();
var CharFormat: TCharformat;
begin
FillChar(CharFormat, 0, sizeof(CharFormat));
CharFormat.cbSize := sizeof(CharFormat);
CharFormat.dwMask := CFM_LINK;
charformat.dwEffects := CFM_LINK;
SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@CharFormat));
end;
end. (* RichEditURL.pas *)