function TegsDelete2(const Source: string):string;
var
  Step, TagCnt : Integer;
  ResChar, SrcChar: PChar;
begin                      
  TagCnt:=0;
  SetLength(Result, Length(Source));  (*создаем выход с длинной =*)
  if Length(Source)=0 then   Exit;

  SrcChar:=@Source[1]; (*копировать первый символ указатель на память*)
  ResChar:=@Result[1];
  for Step:=1 to Length(Source) (*цикл*)
   do   begin
         case SrcChar^ of
           '<': Inc(TagCnt);
           '>': Dec(TagCnt);
           else   if TagCnt<=0 then
                       begin  (*вот тут копирование нужных символов*)
                         ResChar^:=SrcChar^;
                         Inc(ResChar);
                         TagCnt:=0
                       end
          end;
         Inc(SrcChar)
        end;
  SetLength(Result, ResChar-PChar(@Result[1]));  (*обрезаем лишнее в строке*)
end;