RichEdit怎么设置一段文字打开一个超链接?

Question

如点击“雅虎”进入雅虎主页。

Answer 1

uses RichEdit
.....
var
  mask: Word;
  s: string;
begin
  mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
  RichEdit1.Text :='http://www.yahoo.com';
end;这样你以后每加一个网址格式的字符串，就会变成超级连接

Answer 2

不好意思，这样只能显示一个连接在RichEdit上，但还不能发生实际的动作，还需要覆盖form的procedure WndProc(var Msg: TMessage);override;  以处理ENM_LINK
procedure TForm1.WndProc(var Msg: TMessage);
var
  p: TENLink;
  sURL: string;
  CE : TRichEdit;
begin
 if (Msg.Msg = WM_NOTIFY) then
 begin
  if (PNMHDR(Msg.lParam).code = EN_LINK) then
  begin
   p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
   if (p.Msg = WM_LBUTTONDOWN) then
   begin
    try
     CE := TRichEdit(Form1.ActiveControl);
     SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
     sURL := CE.SelText;
     ShellExecute(Handle, 'open', PChar(sURL), nil, nil, SW_SHOWNORMAL);
    except
    end;
   end;
  end;
 end; inherited;
end;具体的文章可以见这里：
http://delphi.about.com/library/weekly/aa111803a.htm

Answer 3

这就是实现了超级连接呀，不过你要的用“雅虎” 进行连接，用上面的方法就不好做了只能用下面的方法模拟，但不是很稳定了：可以试试
procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Text :='雅虎';
  RichEdit1.SelStart:=0;RichEdit1.SelLength:=4;
  RichEdit1.SelAttributes.Color:=clblue;
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsUnderline];
  //RichEdit1.SelAttributes.
end;procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if RichEdit1.SelText='雅虎' then
   ShellExecute(Handle, 'open', 'http://www.yahoo.com', nil, nil, SW_SHOWNORMAL);
end;

Answer 4

这个方法要简单一些，不用设置EVENTMASK，可以满足你的要求，但不如第一种方法好，我只是建议一下。第一中方法知识不能用文字连接而已，但它可以自己判断URL格式的字符串

Answer 5

谢你了！
第一次点击之后，双击才能自动连接。
要是在RichEdit上加入的内容多了，就不能响应连接了。

Answer 6

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons;type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    Edit1: TEdit;
    Button1: TButton;
    FontDialog1: TFontDialog;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure InitRichEditURLDetection(RE : TRichEdit);
  public
    { Public declarations }
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;var
  Form1: TForm1;implementation
{$R *.dfm}uses ShellApi, RichEdit;procedure TForm1.InitRichEditURLDetection(RE: TRichEdit);
var
  mask: Word;
begin
  mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RE.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  s: string;
begin
  InitRichEditURLDetection(RichEdit2);  s:='Great Delphi tutorials and articles at ' +
     'http://www.delphi.about.com.' + #13#10 +
     'About Delphi Programming site!' + #13#10 +
     'Send an email to your Guide: mailto:[email protected]';
  RichEdit1.Text := s;  s:= 'http://www.delphi.about.com. ' + #13#10 +
      ' This Rich Edit does not recognize URLs!'+ #13#10 +
      'http://delphi.about.com. ';
  RichEdit2.Text := s
end;
procedure TForm1.WndProc(var Msg: TMessage);
var
  p: TENLink;
  sURL: string;
  CE : TRichEdit;
begin
 if (Msg.Msg = WM_NOTIFY) then
 begin
  if (PNMHDR(Msg.lParam).code = EN_LINK) then
  begin
   p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
   if (p.Msg = WM_LBUTTONDOWN) then
   begin
    try
     CE := TRichEdit(Form1.ActiveControl);
     SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
     sURL := CE.SelText;
     ShellExecute(Handle, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);
    except
    end;
   end;
  end;
 end; inherited;
end; (* TForm1.WndProc *)procedure TForm1.Button1Click(Sender: TObject);
begin
richedit2.Lines.Add(edit1.Text);
end;end. (* unit1.pas *)
{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: [email protected]
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}