RichEdit上の"http://〜〜"の部分をクリックするとURLを開く方法III (ID:15691)

名前

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

本文

はじめまして、Kazです
再既出質問ですみませんが、
RichEdit上の"http://〜〜"の部分をクリックするとURLを開く方法、
  ・既出質問２です
    https://www.petitmonte.com/bbs/answers?question_id=2600
  ・既出質問１です
    https://www.petitmonte.com/bbs/answers?question_id=200
再度アドバイスいただけないでしょうか。

これに非常に興味があり、トライしているのですがうまくできません。
コンパイルはできますが、実行するとエラーメッセージ
「Project1.exeがEResNotFound を生成しました。TForm1リソースが見つかりません」となります。

作成手順は...RichEdit配置し、その後のコードは↓となっています。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, richedit;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEditWndProc(var Msg: TMessage);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
  OldRichEditWndProc: TWndMethod;

implementation

//フォーム作成時に、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;

end.

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

戻る