有一回我在Microsoft Word里面写一个程序文档，当我输入"http://"的时候，这几个字被高亮显示了。完成网址输入后，甚至还加上了下划线。我把鼠标移到URL上，指针变成了手形。点击之后，IE窗口出现了，并把我带到那个站点。当时我老板看到了这一幕，然后他叫起来："就是它！我们也要实现这种效果！"

于是我开始考虑哪个控件比较合适用来实现这种效果。我只想到RichEdit。效果有三个要素：

1、 必须能检测到URL。

2、必须能检测到鼠标在URL上的移动，变化鼠标指针。

2、 URL被点击时，要启动IE，启动正确的页面。

RichEdit与URL检测

试着搜索一下riched*.dll，你会找到两个--RICHED32.DLL和RICHED20.DLL--位于windows\system或winnt\system32文件夹中。前一个文件实现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版支持的其它特性，肯定还有别的好东东。