[일반/컴포넌트] RichEdit에서 HTML 태그를 다른색으로 표시하기

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

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;

    mask := SendMessage(RichEdit.Handle, EM_GETEVENTMASK, 0, 0);
    SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, 0);
    with RichEdit do
    begin
      SelStart := length(Text);
      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
      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);
    RichEdit.Lines.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEditHTMLTagPickUp(RichEdit1, clBlue);
end;

end.