delphi 使Richedit中的链接可以点击

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, RichEdit, ShellAPI;

type

TForm1 = class(TForm)

RichEdit1: TRichEdit;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

procedure WndProc(var Msg: TMessage); override;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

mask: Word;

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);

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(Self.ActiveControl);

SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));

sURL := CE.SelText;

ShellExecute(0, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);

except

end;

inherited;

end;

end.

推荐分享