RichEdiT的问题.

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit;type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RichEdit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FURL: string;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}uses
  ShellApi;procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  I, L: Integer;
  S, T: string;
  vRect: TRect;
begin
  FURL := '';
  vRect.Left := X;
  vRect.Top := Y;
  X := TRichEdit(Sender).Perform(EM_CHARFROMPOS, 0,
    Longint(@vRect.TopLeft)) and $0000FFFF + 1;
  S := TRichEdit(Sender).Text;
  L := Length(S);
  if (X > L) or (X < 0) or (not (S[X] in [#33..#172])) then begin
    RichEdit1.Cursor := crDefault;
    Exit;
  end;
  T := S[X];
  for I := X - 1 downto 1 do
    if S[I] in [#33..#172] then
      T := S[I] + T
    else Break;
  for I := X + 1 to L do
    if S[I] in [#33..#172] then
      T := T + S[I]
    else Break;
  I := Pos('MAILTO:', UpperCase(T));
  if I <= 0 then I := Pos('HTTP://', UpperCase(T));
  if I <= 0 then I := Pos('FTP://', UpperCase(T));
  if I <= 0 then I := Pos('WWW.', UpperCase(T));
  if I <> 1 then begin
    RichEdit1.Cursor := crDefault;
    Exit;
  end;
  FURL := T;
  RichEdit1.Cursor := crHandPoint;
end;procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FURL <> '' then
    ShellExecute(Handle, 'open', PChar(FURL), nil, nil, SW_SHOW);
end;procedure TForm1.RichEdit1Change(Sender: TObject);
var
  S: string;
  T: string;
  I, J, L: Integer;
  vSelStart: Integer;
  vSelLength: Integer;
begin
  TRichEdit(Sender).Perform(EM_HIDESELECTION, Longint(True), 0);  S := TRichEdit(Sender).Text;
  L := Length(S);
  J := 1;
  vSelStart := TRichEdit(Sender).SelStart;
  vSelLength := TRichEdit(Sender).SelLength;
  TRichEdit(Sender).SelStart := 0;
  TRichEdit(Sender).SelLength := L;
  TRichEdit(Sender).SelAttributes.Color := clWindowText;
  TRichEdit(Sender).SelAttributes.Style := [];
  while J <= L do begin
    T := '';
    for I := J to L do
      if S[I] in [#33..#172] then
        T := T + S[I]
      else Break;
    if T <> '' then begin
      I := Pos('MAILTO:', UpperCase(T));
      if I <= 0 then I := Pos('HTTP://', UpperCase(T));
      if I <= 0 then I := Pos('FTP://', UpperCase(T));
      if I <= 0 then I := Pos('WWW.', UpperCase(T));
      if I = 1 then begin
        TRichEdit(Sender).SelStart := J - 1;
        TRichEdit(Sender).SelLength := Length(T);
        TRichEdit(Sender).SelAttributes.Color := clBlue;
        TRichEdit(Sender).SelAttributes.Style := [fsUnderline];
      end;
      Inc(J, Length(T));
    end;
    Inc(J);
  end;
  TRichEdit(Sender).SelStart := vSelStart;
  TRichEdit(Sender).SelLength := vSelLength;
  TRichEdit(Sender).Perform(EM_HIDESELECTION, Longint(False), 0);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Text :=
'中国软件 http://www.csdn.net'#13#10 +
'Delphi Fans联盟 http://kingron.myetang.com'#13#10 +
'中文开发在线 http://www.codelphi.com'#13#10 +
''#13#10;
end;end.
嘻嘻嘻 伴水 :) 版权