RichEdit上の"http://〜〜"をクリックするとURLを開く方法 (ID：13950)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

Delphian Worldのコンポーネントを使わないのであれば(と言ってもC++Builder用でしたが)、次のようにすればよろしいかと。

TForm1に、
    OldRichEditWndProc: TWndMethod;
    procedure RichEditWndProc(var Msg: TMessage);
を定義。

以下実装。

//フォーム作成時に、URLを認識できるようにする
//RichEdit1をサブクラス化
procedure TForm1.FormCreate(Sender: TObject);
var
  Mask: DWORD;
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);
  OldRichEditWndProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := RichEditWndProc;
end;

//URLをどうにかしたときに、CN_NOTIFYイベントが飛んでくるので処理。それ以外はデフォルト。
procedure TForm1.RichEditWndProc(var Msg: TMessage);
var
  NotifyMsg: TWMNotify;
  Enl: TENLink;
  L: Integer;
  tmp: CHARRANGE;
  Url: String;
begin
  if Msg.Msg = CN_NOTIFY then
  begin
    NotifyMsg := TWMNotify(Msg);
      if NotifyMsg.NMHdr^.code = EN_LINK then
    begin
      CopyMemory(@Enl, PCHAR(Msg.LParam), SizeOf(TENLink));
//Enl.msgに、左クリックだとか右クリックだとかのメッセージが入るので、適宜処理。
//ここではWM_LBUTTONUP
      if Enl.msg = WM_LBUTTONUP then
      begin
              L := Enl.chrg.cpMax - Enl.chrg.cpMin;
        SetLength(Url, L);
        SendMessage(RichEdit1.Handle, EM_EXGETSEL,   0, LPARAM(@tmp));
                    SendMessage(RichEdit1.Handle, EM_EXSETSEL,   0, LPARAM(@Enl.chrg));
                    SendMessage(RichEdit1.Handle, EM_GETSELTEXT, 0, LPARAM(@Url[1]));
                    SendMessage(RichEdit1.Handle, EM_EXSETSEL,   0, LPARAM(@tmp));

//この時点で、Url変数にURLが入ってくるので、どうとでも処理してください。
//ここではForm1のCaptionにURLを表示するだけ。
        Caption := Url;
      end;
    end
    else
    begin
      OldRichEditWndProc(Msg);
    end;
  end
  else
  begin
    OldRichEditWndProc(Msg);
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る