谁能给我传一份改进后的Richedit控件？

加上原文:在RichEdit控制中侦测URL
Elias J. Ongpoy
摘　要：如何创建支持2.0版的RichEdit组件
关键字：RichEdit,URL
类　别：VCL

中文开发在线原创作品，未经允许，严禁任何形式的转载有一回我在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版支持的其它特性，肯定还有别的好东东。下载ONGPOY.ZIP【CoDelphi.com 翻译】转载请注明出处

调试易

谁能给我传一份改进后的Richedit控件？

解决方案 »