16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"RE:ハイパーリンク文字列のハイライト表示"
この発言は #00685 H-Triton さんのハイパーリンク文字列のハイライト表示 に対するコメントです
H-Tritonです。
URLの部分にマウスカーソルを持っていった時に手の形に変えたり、実際に
URLへジャンプするコードを追加する際に便利なように手直しをします。
Nifty-URLにはライブラリを表すもの(例:nifty:FDELPHI/LIB/02/123)もあり
ますが、これは無視して会議室(MES)だけを取得するように変更します。
また、FindTextの引数を「http://www.」としていましたが、これだと
「http://member.」を無視してしまうため「http://」と変更します。
ハイパーリンク文字列(Niftyや Web SiteのURL)を RichEditのキャレット位置
から検索開始して、見つけたらハイライト表示(文字色を変えてアンダーライン
をつける)します。
以下のサンプルコードでは便宜上、関数をメインフォーム(TForm1)の Private
メンバーとしています。
{前略}
implementation
{$R *.DFM}
const
// 後で使い回せるように URL文字の集合を定数にしておきます。
WwwUrlChar = ['0'..'9','A'..'Z','a'..'z','%',':','-','.','/','~','_'];
NifUrlChar = ['0'..'9', 'A'..'Z', 'a'..'z', ':', '/'];
function TForm1.HiliteURL(Kind: Integer): Integer;
// 引数 Kind : 0で Nifty-URL、1で WWW-URLを指定する。
// 関数は、URLを見つけたらその位置(インデックス)を返し、URL文字列の後
// にキャレットをセットします。
// URL文字列が見つからなければ関数は -1を返します。
var
m: Integer;
Col: TColor;
S: string;
begin
Result:= -1;
with RichEdit1 do
begin
if Kind = 0 then
begin
Result:= FindText('nifty:', SelStart, Length(Text), [stMatchCase]);
if Result = -1 then Exit else SelStart:= Result;
m:= SelStart + 1;
while Text[m] in NifUrlChar do Inc(m);
S:= Copy(Text, Result + 1, m - SelStart);
if Pos('/MES/', S) = 0 then
begin
SelStart:= m;
Exit;
end;
Col:= clBlue;
end else
if Kind = 1 then
begin
Result:= FindText('http://www.', SelStart, Length(Text), [stMatchCase]);
if Result = -1 then Exit else SelStart:= Result;
m:= SelStart + 1;
while Text[m] in WwwUrlChar do Inc(m);
Col:= clGreen;
end else Exit;
SelLength:= m - SelStart - 1;
SelAttributes.Style:= [fsUnderline];
SelAttributes.Color:= Col;
SelStart:= m;
end;
end;
// ボタンイベントでHiliteURL関数を呼び出します。
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i:= 0 to 1 do
begin
RichEdit1.SelStart:= 0;
repeat until HiliteURL(i) = -1;
end;
end;
★ AvalonU使うならログブラウザ「えるつぅ」公開中 ★
AvalonないとNIFTYできない(^^) H-Triton Since 1996
Original document by H-Triton 氏 ID:(QZV11422)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum
|