I
import
Unregistered / Unconfirmed
GUEST, unregistred user!
有一回我在Microsoft Word里面写一个程序文档，当我输入"http://"的时候，这几个字被高亮显示了。完成网址输入后，甚至还加上了下划线。我把鼠标移到URL上，指针变成了手形。点击之后，IE窗口出现了，并把我带到那个站点。当时我老板看到了这一幕，然后他叫起来："就是它！我们也要实现这种效果！"
于是我开始考虑哪个控件比较合适用来实现这种效果。我只想到RichEdit。效果有三个要素：
1、 必须能检测到URL。
2、必须能检测到鼠标在URL上的移动，变化鼠标指针。
2、 URL被点击时，要启动IE，启动正确的页面。
RichEdit与URL检测
试着搜索一下riched*.dll，你会找到两个--RICHED32.DLL和RICHED20.DLL--位于windows或winnt文件夹中。前一个文件实现RichEdit 1.0版本的特性，后一个文件实现新的2.0版特性。
Delphi的RichEdit组件没有实现URL检测。看看RichEdit的源码（comctrls.pas），你会发现Borland仍然是用RichEdit 1.0版本。很不幸，因为Microsoft RichEdit控制的2.0版本支持URL检测和其它很多有用的特性。
重建RichEdit--技术不是问题！
只需要做一件事--基于新的RichEdit 2.0版本重写Borland组件。
首先，我把comctrls.pas文件拷贝成新文件，命名为Riched20.pas。把所有的类删掉，只剩下和TcustomRichEdit类有关的。然后把类重命名为TextCustomRichEdit。现在开始重建2.0版本的RichEdit。
在CreateParams过程中，把RichEditmoduleName常量的分配从RICHED32.DLL改为RICHED20.DLL（见代码段一）。同样要修改CreateSubClass过程，因为它也使用旧版本。有两个可供使用的类--ANSI和UNICODE，分别包括了RICHEDIT_CLASSA和RICHEDIT_CLASSW常量。我打算用ANSI版本的RichEdit类，也就是RICHEDIT_CLASSA。
代码段一基于Microsoft RichEdit 2.0的新Delphi RichEdit组件的CreateParams过程
procedure TExtCustomRichEdit.CreateParams
(var Params: TCreateParams);
const
// Use vers 2.0 of RichEdit, previously RICHED32.DLL
RichEditModuleName = 'RICHED20.DLL';
HideScrollBar : array[Boolean] of DWORD =
(ES_DISABLENOSCROLL, 0);
HideSelections: array[Boolean] of DWORD =
(ES_NOHIDESEL, 0);
begin
if FRichEditModule = 0 then
begin
FRichEditModule :=
LoadLibrary(RichEditModuleName);
if FRichEditModule <= HINSTANCE_ERROR then
FRichEditModule := 0;
end;
inherited CreateParams(Params);
CreateSubClass(Params, RICHEDIT_CLASSA);
with Params do
begin
Style := Style or HideScrollBar[HideScrollBars] or
HideSelections[HideSelection];
WindowClass.style := WindowClass.style and not
(CS_HREDRAW or CS_VREDRAW);
end;
end;
URL检测
为了让组件收到EN_LINK消息，在发送EM_SETEVENTMASK的时候，包括了ENM_LINK消息（见代码段二）。同样，创建窗口时，发送一条EM_AUTOURLDETECT消息，激活CFE_LINK效果。这个效果变化URL的颜色，并且加上下划线。
代码段二CreateWnd过程
procedure TExtCustomRichEdit.CreateWnd;
var
Plain, DesignMode, WasModified: Boolean;
begin
WasModified := inherited Modified;
inherited CreateWnd;
if (SysLocale.FarEast) and
not (SysLocale.PriLangID = LANG_JAPANESE) then
Font.Charset := GetDefFontCharSet;
// 添加 ENM_LINK，以接收 EN_LINK 消息
SendMessage(Handle, EM_SETEVENTMASK, 0,
ENM_CHANGE or ENM_SELCHANGE or
ENM_REQUESTRESIZE or
ENM_PROTECTED or ENM_LINK);
// 激活URL检测特性
SendMessage(Handle, EM_AUTOURLDETECT,
Ord(FURLDetect), 0);
SendMessage(Handle, EM_SETBKGNDCOLOR, 0,
ColorToRGB(Color));
if FMemStream <> nil then
begin
Plain := PlainText;
FMemStream.ReadBuffer(DesignMode,
sizeof(DesignMode));
PlainText := DesignMode;
try
Lines.LoadFromStream(FMemStream);
FMemStream.Free;
FMemStream := nil;
finally
PlainText := Plain;
end;
end;
Modified := WasModified;
end;
鼠标指针移到URL文字上时，RichEdit控件接收到一条EN_LINK通知。这样，控件就可以改变鼠标指针形状，引导用户点击URL，启动正确的浏览器（见代码段三）。
代码段三改变鼠标指针形状
procedure TExtCustomRichEdit.CNNotify
(var Message: TWMNotify);
type
PENLink = ^TENLink;
begin
with Message do
case NMHdr^.code of
EN_SELCHANGE:
SelectionChange;
EN_REQUESTRESIZE:
RequestSize(PReqSize(NMHdr)^.rc);
EN_SAVECLIPBOARD:
with PENSaveClipboard(NMHdr)^ do
if not SaveClipboard(cObjectCount, cch)
then Result := 1;
EN_PROTECTED:
with PENProtected(NMHdr)^.chrg do
if not ProtectChange(cpMin, cpMax) then
Result := 1;
// 收到EN_LINK 消息，做出回应
EN_LINK:
begin
Windows.SetCursor
(Screen.Cursors[crHandPoint]);
if PEnLink(NMHdr)^.msg = WM_LBUTTONDOWN then
begin
// 设置选择范围
SendMessage(Handle, EM_EXSETSEL, 0,
Longint(@PEnLink(NMHdr)^.chrg));
// 传递给Windows并打开
ShellExecute(handle, 'open',
PChar(GetSelText), nil, nil,
SW_SHOWNORMAL);
end;
end;
end;
end;
收到消息后，EN_LINK消息包括了一个NMHdr结构，指向ENLINK结构，如下所示：
ENLINK = record
nmhdr: TNMHdr;
msg: UINT;
wParam: WPARAM;
lParam: LPARAM;
chrg: TCharRange;
end;
可以把NMHdr结构指派到ENLINK结构，以得到包括WM_LBUTTONCLICK消息的msg域。Chrg变量包含地址和URL的长度。
_charrange = record
cpMin: Longint;
cpMax: LongInt;
end;
导航到URL
使用chrg变量传递EM_EXSETSEL消息，以得到URL文字，设置选择范围。
SendMessage(Handle, EM_EXSETSEL, 0,
Longint(@PEnLink(NMHdr)^.chrg));
执行ShellExecute，运行浏览器：
ShellExecute(handle, 'open', PChar(GetSelText),
nil, nil, SW_SHOWNORMAL);
设置URL检测属性
为TextRichEdit创建一个名为URLDetect的属性：
property URLDetect : boolean
read FURLDetect
write SetURLDetect
default FALSE;
键入以下代码。当URLDetect属性被设置时，调用RecreateWnd函数，重新激活CreateWnd过程，刷新当前的RichEdit，打开/关闭AutoURL检测特性。
procedure TExtCustomRichEdit.SetURLDetect(
Value: boolean);
begin
if URLDetect <> Value then
begin
FURLDetect:= Value;
RecreateWnd;
end;
end;
小结
图一展示了用新RichEdit 2.0组件实现的示例程序。支持http:,file:,mailto:,https:,gopher:,news:,nntrp:,properto:,telnet:和wais。
图二
通过利用Microsoft RichEdit 2.0创建组件，就可以使用URL检测特性了。看看2.0版支持的其它特性，肯定还有别的好东东。
于是我开始考虑哪个控件比较合适用来实现这种效果。我只想到RichEdit。效果有三个要素：
1、 必须能检测到URL。
2、必须能检测到鼠标在URL上的移动，变化鼠标指针。
2、 URL被点击时，要启动IE，启动正确的页面。
RichEdit与URL检测
试着搜索一下riched*.dll，你会找到两个--RICHED32.DLL和RICHED20.DLL--位于windows或winnt文件夹中。前一个文件实现RichEdit 1.0版本的特性，后一个文件实现新的2.0版特性。
Delphi的RichEdit组件没有实现URL检测。看看RichEdit的源码（comctrls.pas），你会发现Borland仍然是用RichEdit 1.0版本。很不幸，因为Microsoft RichEdit控制的2.0版本支持URL检测和其它很多有用的特性。
重建RichEdit--技术不是问题！
只需要做一件事--基于新的RichEdit 2.0版本重写Borland组件。
首先，我把comctrls.pas文件拷贝成新文件，命名为Riched20.pas。把所有的类删掉，只剩下和TcustomRichEdit类有关的。然后把类重命名为TextCustomRichEdit。现在开始重建2.0版本的RichEdit。
在CreateParams过程中，把RichEditmoduleName常量的分配从RICHED32.DLL改为RICHED20.DLL（见代码段一）。同样要修改CreateSubClass过程，因为它也使用旧版本。有两个可供使用的类--ANSI和UNICODE，分别包括了RICHEDIT_CLASSA和RICHEDIT_CLASSW常量。我打算用ANSI版本的RichEdit类，也就是RICHEDIT_CLASSA。
代码段一基于Microsoft RichEdit 2.0的新Delphi RichEdit组件的CreateParams过程
procedure TExtCustomRichEdit.CreateParams
(var Params: TCreateParams);
const
// Use vers 2.0 of RichEdit, previously RICHED32.DLL
RichEditModuleName = 'RICHED20.DLL';
HideScrollBar : array[Boolean] of DWORD =
(ES_DISABLENOSCROLL, 0);
HideSelections: array[Boolean] of DWORD =
(ES_NOHIDESEL, 0);
begin
if FRichEditModule = 0 then
begin
FRichEditModule :=
LoadLibrary(RichEditModuleName);
if FRichEditModule <= HINSTANCE_ERROR then
FRichEditModule := 0;
end;
inherited CreateParams(Params);
CreateSubClass(Params, RICHEDIT_CLASSA);
with Params do
begin
Style := Style or HideScrollBar[HideScrollBars] or
HideSelections[HideSelection];
WindowClass.style := WindowClass.style and not
(CS_HREDRAW or CS_VREDRAW);
end;
end;
URL检测
为了让组件收到EN_LINK消息，在发送EM_SETEVENTMASK的时候，包括了ENM_LINK消息（见代码段二）。同样，创建窗口时，发送一条EM_AUTOURLDETECT消息，激活CFE_LINK效果。这个效果变化URL的颜色，并且加上下划线。
代码段二CreateWnd过程
procedure TExtCustomRichEdit.CreateWnd;
var
Plain, DesignMode, WasModified: Boolean;
begin
WasModified := inherited Modified;
inherited CreateWnd;
if (SysLocale.FarEast) and
not (SysLocale.PriLangID = LANG_JAPANESE) then
Font.Charset := GetDefFontCharSet;
// 添加 ENM_LINK，以接收 EN_LINK 消息
SendMessage(Handle, EM_SETEVENTMASK, 0,
ENM_CHANGE or ENM_SELCHANGE or
ENM_REQUESTRESIZE or
ENM_PROTECTED or ENM_LINK);
// 激活URL检测特性
SendMessage(Handle, EM_AUTOURLDETECT,
Ord(FURLDetect), 0);
SendMessage(Handle, EM_SETBKGNDCOLOR, 0,
ColorToRGB(Color));
if FMemStream <> nil then
begin
Plain := PlainText;
FMemStream.ReadBuffer(DesignMode,
sizeof(DesignMode));
PlainText := DesignMode;
try
Lines.LoadFromStream(FMemStream);
FMemStream.Free;
FMemStream := nil;
finally
PlainText := Plain;
end;
end;
Modified := WasModified;
end;
鼠标指针移到URL文字上时，RichEdit控件接收到一条EN_LINK通知。这样，控件就可以改变鼠标指针形状，引导用户点击URL，启动正确的浏览器（见代码段三）。
代码段三改变鼠标指针形状
procedure TExtCustomRichEdit.CNNotify
(var Message: TWMNotify);
type
PENLink = ^TENLink;
begin
with Message do
case NMHdr^.code of
EN_SELCHANGE:
SelectionChange;
EN_REQUESTRESIZE:
RequestSize(PReqSize(NMHdr)^.rc);
EN_SAVECLIPBOARD:
with PENSaveClipboard(NMHdr)^ do
if not SaveClipboard(cObjectCount, cch)
then Result := 1;
EN_PROTECTED:
with PENProtected(NMHdr)^.chrg do
if not ProtectChange(cpMin, cpMax) then
Result := 1;
// 收到EN_LINK 消息，做出回应
EN_LINK:
begin
Windows.SetCursor
(Screen.Cursors[crHandPoint]);
if PEnLink(NMHdr)^.msg = WM_LBUTTONDOWN then
begin
// 设置选择范围
SendMessage(Handle, EM_EXSETSEL, 0,
Longint(@PEnLink(NMHdr)^.chrg));
// 传递给Windows并打开
ShellExecute(handle, 'open',
PChar(GetSelText), nil, nil,
SW_SHOWNORMAL);
end;
end;
end;
end;
收到消息后，EN_LINK消息包括了一个NMHdr结构，指向ENLINK结构，如下所示：
ENLINK = record
nmhdr: TNMHdr;
msg: UINT;
wParam: WPARAM;
lParam: LPARAM;
chrg: TCharRange;
end;
可以把NMHdr结构指派到ENLINK结构，以得到包括WM_LBUTTONCLICK消息的msg域。Chrg变量包含地址和URL的长度。
_charrange = record
cpMin: Longint;
cpMax: LongInt;
end;
导航到URL
使用chrg变量传递EM_EXSETSEL消息，以得到URL文字，设置选择范围。
SendMessage(Handle, EM_EXSETSEL, 0,
Longint(@PEnLink(NMHdr)^.chrg));
执行ShellExecute，运行浏览器：
ShellExecute(handle, 'open', PChar(GetSelText),
nil, nil, SW_SHOWNORMAL);
设置URL检测属性
为TextRichEdit创建一个名为URLDetect的属性：
property URLDetect : boolean
read FURLDetect
write SetURLDetect
default FALSE;
键入以下代码。当URLDetect属性被设置时，调用RecreateWnd函数，重新激活CreateWnd过程，刷新当前的RichEdit，打开/关闭AutoURL检测特性。
procedure TExtCustomRichEdit.SetURLDetect(
Value: boolean);
begin
if URLDetect <> Value then
begin
FURLDetect:= Value;
RecreateWnd;
end;
end;
小结
图一展示了用新RichEdit 2.0组件实现的示例程序。支持http:,file:,mailto:,https:,gopher:,news:,nntrp:,properto:,telnet:和wais。
图二
通过利用Microsoft RichEdit 2.0创建组件，就可以使用URL检测特性了。看看2.0版支持的其它特性，肯定还有别的好东东。