こんばんは〜 H-Tritonです。
TEditor上でハイライト表示された URL(Mail Address, Nifty URLを含む)
に対するマウス操作の処理です。

なぞった時：
(1)マウスカーソルを手の形に変る
(2)URLが持つ情報(URLの種類、URL文字列、フォーラム名、会議室番号、
   会議室発言番号)をレコード型に格納する。

クリックした時：
(3)レコード型が保持する情報をメッセージボックスに表示する。
   (実際のアプリでは、そのURLへジャンプするなどの処理に置き換わる)

type
  TUrlKind = (ukMail, ukWeb, ukNif, ukNone);
//  (URLの種類＝メールアドレス, Web URL, Nifty URL, URL機能なし)
  TUrlInfo = record
    UrlKind: TUrlKind;    // URLの種類
    UrlStr: string;       // URL文字列
    NifForumName: string; // Niftyのフォーラム名
    NifRoomNo: string;    // Niftyの会議室番号
    NifMsgNo: string;     // Niftyの会議室発言番号
  end;

// マウスでなぞった時の処理
// ここで呼び出している関数 IsStrAlphaUpCaseとIsStrNumericは
// nifty:FDELPHI/MES/16/965と共用しています。
// コードはそちらにあります。
procedure TForm1.Editor1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
const
  NifChar = ['0'..'9','A'..'Z', 'a'..'z', ':', '/'];
var
  P: TPoint;
  S: string;
  i, j: Integer;
  StrInfo: TEditorStrInfo;
  Parser: TEditorParser;
  NifUrl: Boolean;
  uInfo: TUrlInfo;
begin
  Editor1.Cursor:= crDefault;
  uInfo.UrlKind:= ukNone;
  uInfo.UrlStr:= '';
  uInfo.NifForumName:= '';
  uInfo.NifMsgNo:= '';
  uInfo.NifRoomNo:= '';
  P.x:= X;
  P.y:= Y;
  with Editor1 do if TokenFromPos(P) in [toUrl, toMail] then
  begin
    Cursor:= crHandPoint;
    if TokenFromPos(P) = toUrl then
      uInfo.UrlKind:= ukWeb else uInfo.UrlKind:= ukMail;
      uInfo.UrlStr:= TokenStringFromPos(P);
      UrlInfo:= uInfo;
  end else
  begin
    StrInfo:= StrInfoFromPos(P);
    if (StrInfo.Line < 0) or (StrInfo.Line > Lines.Count - 1) then
    begin
      UrlInfo:= uInfo;
      StatusBar1.SimpleText:= uInfo.UrlStr;
      Exit;
    end;
    i:= StrInfo.CharIndex;
    S:= Lines[StrInfo.Line];
    if not (S[i+1] in NifChar) then
    begin
      UrlInfo:= uInfo;
      StatusBar1.SimpleText:= UrlInfo.UrlStr;
      Exit;
    end;
    repeat
      if Copy(S, i, 6) = 'nifty:' then Break;
      Dec(i);
    until i = -1;
    if i = -1 then Exit;
    J:= -1;
    Parser:= TEditorParser.Create(S);
    try
      while Parser.Token <> toEOF do
      begin
        NifUrl:= False;
        if Parser.SourcePos = i-1 then j:= 0;
        case j of
          0: if Parser.TokenString = 'nifty' then NifUrl:= True;
          1: if Parser.TokenString = ':' then NifUrl:= True;
          2: if IsStrAlphaUpCase(Parser.TokenString) then
             begin
               uInfo.NifForumName:= Parser.TokenString;
               NifUrl:= True;
             end;
          3, 5, 7: if Parser.TokenString = '/' then NifUrl:= True;
          4: if Parser.TokenString = 'MES' then NifUrl:= True;
          6: if IsStrNumeric(Parser.TokenString) then
             begin
               uInfo.NifRoomNo:= Parser.TokenString;
               NifUrl:= True;
             end;
          8: if IsStrNumeric(Parser.TokenString) then
             begin
               uInfo.NifMsgNo:= Parser.TokenString;
               NifUrl:= True;
             end;
        end;
        if NifUrl then
        begin
          uInfo.UrlStr:= uInfo.UrlStr + Parser.TokenString;
          if j = 8 then
          begin
            Cursor:= crHandPoint;
            uInfo.UrlKind:= ukNif;
            UrlInfo:= uInfo;
            Break;
          end else Inc(j);
        end;
        Parser.NextToken;
      end;
    finally
      Parser.Free;
    end;
  end;
  StatusBar1.SimpleText:= uInfo.UrlStr;
end;

// クリックした時
procedure TForm1.Editor1Click(Sender: TObject);
var
  Kind: string;
begin
  case UrlInfo.UrlKind of
    ukMail: Kind:= 'Mail';
    ukWeb : Kind:= 'Web URL';
    ukNif : Kind:= 'Nifty URL';
    ukNone: Exit;
  end;
  ShowMessage('Kind : ' + Kind + #13 +
              'URL  : ' + UrlInfo.UrlStr + #13 +
              'Forum Name : ' + UrlInfo.NifForumName + #13 +
              'Room Name  : ' + UrlInfo.NifRoomNo + #13 +
              'Message No : ' + UrlInfo.NifMsgNo);
end;

                  http://member.nifty.ne.jp/h-triton/
          ○ 快速・大容量テキストエディタ「えるの〜と」進化中 ○
          Avalon's Friendly Crew #80008  H-Triton (^^) since 1996

Original document by H-Triton        氏 ID:(QZV11422)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。