鸿 网 互 联 www.68idc.cn

Delphi 使Richedit中的链接可以点击

来源:互联网 作者:佚名 时间:2021-12-14 17:55
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, RichEdit, ShellAPI;type TForm1 = class(TForm) RichEdit1: TRichEdit; procedure FormCreate(Sender: TObject); pri
unit Unit1;interfaceuses  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;      end;    end;  end;  inherited;end;end.
网友评论
<