Delphi Tips 
-----------------------------

0216  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/08/25 おばQ rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/01 おばQ 編集
RichEditでHTMLタグを色・書式付き表示をする

HTMLソースを表示する時タグだけ色分けや書式付きで表示されると便利です。
以下のソースを入力して、RichEditにHTMLソースを表示させて
ボタンを押すと、なかなか高速にタグだけに色がつきます。
テキストを検索してSelAttributesで色付けしてもいいのですが、
あまりにも遅いのでほとんどAPIを使います。

タグを入力してリアルタイムに色をつけることは少々ムズカシそうだったので
実装していません。こちらと組み合わせてみるのもよいでしょう。
そちらの方法は、自分で考えてね(^^;;;

//関数部
procedure RichEditHTMLTagPickUp(RichEdit: TRichEdit; TagColor: TColor);
    function ColorToStringHex(Value: TColor): string;
    begin
      Result := '$00' + IntToHex(ColorToRGB(Value),6)
    end;
var
  mask: Longint;
  CFmt: TCharFormat;
  Str: String;
  PTop, PPos, PEnd, PNext: PChar;
  CR: TCharRange;
begin
  try
    RichEdit.Lines.BeginUpdate;//高速化、1

    mask := SendMessage(RichEdit.Handle, EM_GETEVENTMASK, 0, 0);//高速化、2
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, 0);
    with RichEdit do
    begin
        SelStart := length(Text);//高速化、3
        Perform(EM_SCROLLCARET, 0, 0);

        case 1 of
          0:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_BOLD;
            CFmt.dwEffects := CFE_BOLD;
          end;
          1:
          begin
            CFmt.cbSize := sizeof(CFmt);
            CFmt.dwMask := CFM_COLOR;
            CFmt.crTextColor := ColorToRGB(TagColor);
          end;
        end;

        Str := RichEdit.Text;
        PTop := PChar(Str);
        PPos := PTop;

        while (AnsiStrScan(PPos, '<') <> nil) do//高速化、4
        begin
          PPos := AnsiStrScan(PPos, '<');
          PEnd := PPos;
          while (AnsiStrScan(PEnd +1 , '>') <> nil) do
          begin
            PNext := AnsiStrScan(PEnd +1 , '>');
            PEnd := PNext +1;
              while (PEnd = PChar(#13)) or (PEnd = PChar(#10)) do
                Inc(PEnd);
              if PEnd <> PChar('<') then Break;
          end;
          CR.cpMin := PPos - PTop;
          CR.cpMax := PEnd - PTop;
          RichEdit.Perform(EM_EXSETSEL, 0, lParam(@CR));
          RichEdit.Perform(EM_SETCHARFORMAT, 1, lParam(@CFmt));//書式決定
          PPos := PEnd;
        end;
    end;
  finally
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, mask);//高速化、2終
    RichEdit.Lines.EndUpdate;//高速化、1終
  end;
end;

//実装部
procedure TForm1.Button2Click(Sender: TObject);
begin
  RichEditHTMLTagPickUp(RichEdit1, Form1.Color);
end;

注意:タグが綺麗に閉じられていないと無限ループに
   はまってしまう事が考えられます。気をつけてください

内部でcase文に1を設定している所があります。
ここを0にしますとHTMLタグがBold属性になります。
1の場合ですとForm1.Colorになります。
適当に書きなおしてください。

RichEditのUndoバッファは影響を受けますので注意です。

元々はC++BuilderMLでのC++Builder用のTipsでしたが、
Delphiに書き換えました。
MLのC++BuilderでのサンプルソースはMLを参照してください。
Delphi版とほぼ同じ内容です。
参照: [builder:8463] <WWW> <通信> <Win95> <コンポーネント >

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords


Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp