DBR Delphi-Ecke

// Hiermit werden im TRichEdit Internet-Adressen automatisch
// gekennzeichnet. Beim Klick auf den Link startet der aktuelle Browser.

// Variante 1

// Getestet mit D4 unter XP

...  
  private 
    { Private-Deklarationen } 
  public 
    procedure WndProc(var Message: TMessage); override; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses richedit, shellapi; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  EVENTMASK: DWord; 
begin 
  EVENTMASK := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0) or ENM_LINK; 
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, EVENTMASK); 
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(true), 0); 
end; 
 
procedure TForm1.WndProc(var Message: TMessage); 
var 
  p: Pointer; 
  enl: TEnLink; 
begin 
  if Message.Msg = WM_NOTIFY then 
  begin 
    if PNMHDR(Message.LParam).code = EN_LINK then begin 
      p := TWMNotify(Message).NMHdr; 
      enl := TenLink(p^); 
      if enl.msg = WM_LBUTTONDOWN then begin 
        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Integer(@enl.chrg)); 
        ShellExecute(Handle, 'open', PChar(RichEdit1.SelText), 
          nil, nil, SW_SHOWNORMAL); 
      end 
    end 
  end; 
  inherited; 
end;

//---------------------------------------------------

// Variante 2


// Getestet mit D2010 unter W7

type 
  TForm1 = class(TForm) 
    RichEdit1: TRichEdit; 
    procedure FormCreate(Sender: TObject); 
  private 
    PrevRichEditWndProc: TWndMethod; 
    procedure RichEditWndProc(var Message: TMessage); 
    procedure SetRichEditMasks; 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses RichEdit, ShellApi; 
 
procedure TForm1.SetRichEditMasks; 
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, 1, 0); 
end; 
 
procedure TForm1.RichEditWndProc(var Message: TMessage); 
var 
  P: Pointer; 
  enl: TEnLink; 
 
  procedure doit; 
  begin 
    RichEdit1.Perform(EM_EXSETSEL, 0, Longint(@enl.chrg)); 
    ShellExecute(Handle, 'open', pchar(RichEdit1.SelText + #32), nil, nil, 
      SW_SHOWNORMAL); 
  end; 
 
begin 
  PrevRichEditWndProc(Message); 
  case Message.msg of 
    CN_NOTIFY: 
      begin 
        P := TWMNotify(Message).NMHdr; 
        enl := TEnLink(P^); 
        if enl.msg = WM_LBUTTONDOWN then 
        begin 
          if RichEdit1 = ActiveControl then // wichtig 
            doit; 
        end; 
      end; 
    CM_RECREATEWND: 
      begin 
        SetRichEditMasks; 
      end; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  PrevRichEditWndProc := RichEdit1.WindowProc; 
  RichEdit1.WindowProc := RichEditWndProc; 
  SetRichEditMasks; 
end;