Add(HilightMemo,1868168,133,42)
{
 Left=20
 Top=18
 Width=335
 Height=220
 Font=[Courier New,12,0,0,1]
 Strings=#20:<br>Слово Слово</br>|19:  <br> Слово </br> |23:  {eeeee}ifthen else   |0:|
 HilightStrings=#14:http://=lime=U|14:{<br>}=Green=B|15:{</br>}=Green=B|12:{then}=Red=B|10:{*}=Blue=B|
 HilightFont=[Courier New,8,0,0,1]
}

function THIHiLightMemo.HiLight;
var
  S, str, CS, U: string;
  i, j, k:       integer;
  _Color:        TColor;
  block:         boolean;
  StrtComm:      string;
  EndComm:       string;
     
  function AnsiCmp(arg:string):boolean;
  begin
    if not _prop_HilightCaseSens then
         Result := AnsiCompareStrNoCase(Copy(S, i+1, Length(arg)), arg)=0
    else Result := AnsiCompareStr      (Copy(S, i+1, Length(arg)), arg)=0;
  end;
 
  procedure SetColorStr;
  var UG: string;
  begin
    if (CS <> '') then
    begin
      CS := Uppercase(CS);
      if (CS[1] in ['0'..'9']) then _Color := str2int(CS)
      else if CS = 'BLACK'     then _Color := clBlack
      else if CS = 'MAROON'    then _Color := clMaroon
      else if CS = 'GREEN'     then _Color := clGreen
      else if CS = 'OLIVE'     then _Color := clOlive
      else if CS = 'NAVY'      then _Color := clNavy
      else if CS = 'PURPLE'    then _Color := clPurple
      else if CS = 'TEAL'      then _Color := clTeal
      else if CS = 'GRAY'      then _Color := clGray
      else if CS = 'SILVER'    then _Color := clSilver
      else if CS = 'RED'       then _Color := clRed
      else if CS = 'LIME'      then _Color := clLime
      else if CS = 'YELLOW'    then _Color := clYellow
      else if CS = 'BLUE'      then _Color := clBlue
      else if CS = 'FUCHSIA'   then _Color := clFuchsia
      else if CS = 'AQUA'      then _Color := clAqua
      else if CS = 'WHITE'     then _Color := clWhite
    end;
    Attrs.fontcolor := _Color;
    Attrs.fontstyle := TFontStyle({$ifdef F_P}integer(_prop_HilightFont.Style)
                                  {$else}_prop_HilightFont.Style{$endif});
    UG := FParse(U, '=');
    while UG <> '' do
    begin
      UG := Uppercase(UG);
      if (UG = 'U') and (oeReadOnly in Options) then
        include(Attrs.fontstyle, fsUnderline)
      else if (UG = 'B') then
        include(Attrs.fontstyle, fsBold)
      else if (UG = 'C') or (UG = 'I') then
        include(Attrs.fontstyle, fsItalic)
      else if (UG = 'S') then
        include(Attrs.fontstyle, fsStrikeOut);
      UG := FParse(U, '=');
    end;
  end;
      
begin
  if HS.Count <> 0 then
    for i := HS.Count - 1 downto 0 do
      if HS.Items[i] = '' then HS.Delete(i);
  S := Lines[FromPos.Y];
  Result := 0;
  if S = '' then exit;
  i := FromPos.X;
  Attrs.fontcolor := Sender.Font.Color;
  Attrs.FontStyle := Sender.Font.FontStyle;

  StrtComm := '';
  EndComm  := '';

  for j := 0 to HS.Count - 1 do
  begin
    U := HS.Items[j];
    str := FParse(U, '=');
    if U <> '' then CS := FParse(U, '=') else CS := '';
    _Color := _prop_HilightFont.Color;
    // ведем поиск блока комментария
    k := PosEx('*', str, 1);
    if  k > 0 then begin
      StrtComm := Copy(str, 1, k - 1);
      EndComm  := Copy(str, k + 1, Length(str));
      if AnsiCmp(StrtComm) then begin
        SetColorStr;
        Result := PosEx(EndComm, S, i+1+Length(StrtComm)) -1+Length(EndComm)-FromPos.x;
        exit;
      end;
    end;
    // ведем поиск конкретного блока засветки
    block := (Length(str)>2)and(str[1] = '{')and(str[Length(str)] = '}');
    if block then str := Copy(str, 2, Length(str)-2);
    if AnsiCmp(str) then begin
      SetColorStr;
      if block then // Блок - заканчиваем сразу
        inc(i,Length(str))
      else // Просто Keyword - дополняем до первого пробела
        while (i<Length(S))and(S[i+1]>' ') do inc(i);
      Result := i - FromPos.x;
      exit;
    end;
  end;
  if (S[i+1]<=' ') then // Ничего не нашли - пробелы пропускаем
    while (i<Length(S))and(S[i+1]<=' ') do inc(i)
  else // Ничего не нашли - следующий поиск со СЛЕДУЮЩЕГО символа
    inc(i);
  Result := i - FromPos.x;
end;