Add(MainForm,2953706,21,105)
{
 Width=645
}
Add(RichEdit,2876974,350,196)
{
 Left=45
 Top=20
 Width=215
 Height=125
 Strings=#30:<br>Доброго времени суток</br>|26:<br>возникла проблема</br>|18:<br>с блочным</br>|32:<br>построением</br><br>...</br>|0:|
 ScrollBars=2
 Point(doSetSelStart)
 Point(doSetSelLength)
 Point(PHandle)
}
Add(Button,6772303,84,259)
{
 Left=15
 Top=190
 link(onClick,107404:doClear,[])
}
Add(InlineCode,6686563,574,371)
{
 WorkPoints=#11:doFormatSel|
 DataPoints=#7:PHandle|5:Color|5:Style|8:FontName|8:FontSize|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|21:uses kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10:   private|0:|9:   public|0:|12:    PHandle,|10:    Color,|10:    Style,|13:    FontName,|24:    FontSize: THI_Event;|4:    |58:    procedure doFormatSel(var _Data: TData; Index: word); |5: end;|0:|14:implementation|0:|34:procedure THiAsmClass.doFormatSel;|3:var|21:  sControl: PControl;|10:  p: byte;|12:  s: string;|13:  i: integer;|0:|5:begin|48:  sControl := PControl(ToIntegerEvent(PHandle));|38:  if not Assigned(sControl) then exit;|2:  |64:  if (sControl.SelLength <> 0) then {no valid selection -> quit}|7:  begin|82:    sControl.RE_CharFmtArea := raSelection; {apply attribute(s) only to selection}|58:    sControl.RE_FmtFontColor := ReadInteger(_Data, Color);|0:|35:    p := ReadInteger(_Data, Style);|39:    sControl.RE_FmtBold := p and 1 > 0;|41:    sControl.RE_FmtItalic := p and 2 > 0;|44:    sControl.RE_FmtUnderline := p and 4 > 0;|37:    s := ReadString(_Data, FontName);|20:    if s <> ''  then|35:      sControl.RE_FmtFontName := s;|43:    i := ReadInteger(_Data, FontSize) * 20;|20:    if i <> 0 then  |36:      sControl.RE_FmtFontSize := i; |6:  end;|4:end;|0:|4:end.|
 link(PHandle,2876974:PHandle,[(580,309)(377,309)])
 link(Color,15505205:Item,[(587,321)(748,321)])
 link(Style,12637678:Value,[(594,303)(678,303)])
 link(FontSize,15187730:GetData,[(608,363)(636,363)])
}
Add(Memory,12637678,672,168)
{
 Default=Integer(1)
}
Add(Replace,10719860,243,385)
{
 SubStr="\10"
 link(onReplace,12013801:doSearch,[])
 link(Str,2876974:Text,[(249,317)(356,317)])
}
Add(Position,12013801,322,385)
{
 ZeroPos=0
 Point(doReset)
 link(onSearch,5040039:doCompare,[])
 link(Target,12862065:Value,[])
}
Add(StrList,2566296,518,182)
{
 FileName="<\r\n"
 Strings=#4:<br>|5:</br>|0:|
 Point(doGetString)
 Point(onGetString)
 link(onGetString,3052450:doEvent1,[(562,195)(562,269)(282,269)(282,342)])
}
Add(If_else,5040039,427,385)
{
 Op2=Integer(0)
 link(onTrue,4306180:doNext,[(506,391)(506,258)])
 link(onFalse,3082822:doEvent1,[(471,398)(471,440)(324,440)(324,482)])
 link(Op1,12013801:Position,[(433,373)(381,373)(381,429)(328,429)])
}
Add(CounterEx,4306180,553,252)
{
 Max=2
 Point(onThroughMax)
 Point(onSet)
 Point(doReset)
 link(onNext,3234645:doWork2,[])
 link(onThroughMax,14717419:doData,[(639,265)(639,419)])
 link(onSet,3234645:doWork3,[(597,272)])
}
Add(HubEx,3234645,593,252)
{
 Angle=3
 link(onEvent,8344171:doEvent1,[(597,232)(583,232)(583,209)])
}
Add(Memory,12862065,329,336)
{
 link(onData,16508325:doLength,[])
}
Add(Length,16508325,406,336)
{
}
Add(Math,3586442,483,427)
{
 OpType=1
 Op2=1
 link(onResult,16142012:doWork3,[(527,433)(527,335)(313,335)])
}
Add(Hub,3082822,336,476)
{
 link(onEvent1,3586442:doOperation,[(395,482)(395,433)])
 link(onEvent2,15104223:doData,[])
}
Add(DoData,15104223,406,483)
{
 link(onEventData,5689443:doEvent1,[])
 link(Data,16508325:Result,[])
}
Add(Hub,5689443,462,483)
{
 link(onEvent1,2876974:doSetSelLength,[(488,489)(488,367)(338,367)(338,244)])
 link(onEvent2,6686563:doFormatSel,[(525,496)(525,377)])
}
Add(HubEx,16142012,309,280)
{
 Angle=3
 link(onEvent,2876974:doSetSelStart,[(313,237)])
}
Add(EventFromData,15187730,630,322)
{
 link(onEvent,8493914:doWork1,[(674,328)(674,351)(221,351)])
}
Add(Hub,3052450,294,336)
{
 link(onEvent1,12862065:doValue,[])
 link(onEvent2,8493914:doWork3,[(320,349)(320,377)])
}
Add(IndexToChanel,9035548,154,343)
{
 Point(Index)
 link(onEvent1,10719860:doReplace,[(214,349)(214,391)])
 link(Index,107404:Value,[])
}
Add(DoData,14717419,693,413)
{
 Data=Integer(1)
 link(onEventData,1506930:doEvent1,[])
}
Add(HubEx,8493914,217,371)
{
 Angle=1
 link(onEvent,9035548:doEvent,[(221,386)(142,386)(142,349)])
}
Add(Memory,107404,154,252)
{
 Default=Integer(0)
 link(onData,4306180:doReset,[(370,258)(370,265)])
}
Add(Hub,1506930,742,413)
{
 link(onEvent1,107404:doValue,[(768,419)(768,339)(142,339)(142,258)])
 link(onEvent2,16142012:doWork1,[(782,426)(782,286)])
}
Add(IntegerArray,9960749,742,182)
{
 IntArray=['0'=255,'0'=65280]
}
Add(ArrayRW,15505205,742,238)
{
 link(Array,9960749:Array,[])
}
Add(Hub,8344171,595,203)
{
 link(onEvent1,15505205:doRead,[(675,209)(675,244)])
 link(onEvent2,2566296:doGetString,[(621,216)(621,223)(506,223)(506,230)])
}

function THIHiLightMemo.HiLight;
..............
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  := '';
  comment := false;

  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;

    // ведем поиск конкретного блока засветки
    block := false;
    if (str[1] = '{') and (str[Length(str)] = '}') then
    begin
      Delete(str, 1, 1);
      if str = '' then exit;
      deleteTail(str, 1);
      if str = '' then exit;
      block := true;
    end;

    // ведем поиск блока комментария
    k := PosEx('*', str, 1);
    if  k > 0 then
    begin
      StrtComm := Copy(str, 1, k - 1);
      EndComm  := Copy(str, k + 1, Length(str));
      comment := true;
    end;

    if (AnsiComp1 = 0) and comment then
    begin
      SetColorStr;
      Result := PosEx(EndComm, S, Length(StrtComm) + 1 + i) + Length(EndComm) - FromPos.x;
      exit;
    end
    else if (AnsiComp2 = 0) and not comment then
    begin
      SetColorStr;
      if block then inc(i,Length(str))
      else 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;

Add(MainForm,2953706,21,105)
{
}
Add(HilightMemo,7253171,84,105)
{
 Left=35
 Top=10
 Width=330
 Height=240
 Font=[Courier New,12,0,0,1]
 Strings=#14:<br>Слово</br>|15:<br>Слово </br>|12:if then else|
 HilightStrings=#14:{<br>}=green=B|15:{</br>}=green=B|12:{then}=red=B|
 HilightFont=[Courier New,8,0,0,1]
}

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;