// Hiermit kann man (ähnlich wie bei StringReplace) Begriffe in einem
// String ersetzen, wobei eingeklammerte Begriffe übergangen werden.
// Außerdem kann festgelegt werden, ob alle Begriffe oder nur die ersten
// bearbeitet werden.


// Getestet mit RS 10.4 unter Win11

function XReplace(const s, OldPattern, NewPattern: string; Number: integer; 
  IgnoreCase: Boolean; Auf: String = '('; Zu: String = ')'): string; 
var 
  pc, ps, ph, x, z, lga, lgn, lgs: integer; 
  c, v: string; 
begin 
  lga := length(OldPattern); 
  if (lga > 0) then 
  begin 
    lgn := length(NewPattern); 
    z := 0; 
    v := lowercase(OldPattern); 
    lgs := length(s); 
    try 
      x := 1; 
      while x <= lgs do 
      begin 
        c := copy(s, x, lga); 
        pc := pos(Auf, c); 
        ps := pos(Zu, copy(s, x + pc, maxint)); 
        if (ps > 0) and (pc > 0) then 
        begin 
          ph := pos(Auf, copy(s, x + pc, maxint)); 
          if (ph = 0) or (ph > ps) then 
          begin 
            Result := Result + copy(c, 1, pc); 
            inc(x, pc); 
            c := copy(s, x, ps); 
            Result := Result + c; 
            inc(x, ps); 
            continue; 
          end; 
        end; 
        if (c = OldPattern) or (IgnoreCase and (lowercase(c) = v)) then 
        begin 
          if lgn > 0 then 
          begin 
            Result := Result + NewPattern; 
          end; 
          inc(z); 
          inc(x, lga); 
          if z = Number then 
            break; 
        end 
        else 
        begin 
          Result := Result + copy(c, 1, 1); 
          inc(x); 
        end; 
      end; 
      Result := Result + copy(s, x, lgs - pred(x)); 
    except 
      Result := 'FEHLER'; 
    end; 
  end 
  else 
    Result := s; 
end; 
 
// Beispiel 1 ergibt: 'Versuch1<Versuch2< Test3 >Versuch4<Test5> Versuch' 
// da Test3 und Test 5 ordnungsgemäß in spitzen Klammern stehen 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Wieoft: integer; 
  Ignorcase: Boolean; 
begin 
  Wieoft := -1; // Alle Vorkommen 
  Ignorcase := True; // bei False würde nichts ersetzt 
  ListBox1.items.add(XReplace('Test1<Test2< Test3 >Test4<Test5> Test', 'test', 
    'Versuch', Wieoft, Ignorcase, '<', '>')); 
end; 
 
// Beispiel 2 ergibt: 'Versuch1<Versuch2< Test3 >Versuch4<Test5> Test' 
// da das letzte "Test" bereits der vierte zu ändernde Begriff wäre 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  Wieoft: integer; 
  Ignorcase: Boolean; 
begin 
  Wieoft := 3; // nur die ersten drei, die nicht in spitzen Klammern stehen 
  Ignorcase := True; 
  ListBox1.items.add(XReplace('Test1<Test2< Test3 >Test4<Test5> Test', 'test', 
    'Versuch', Wieoft, Ignorcase, '<', '>')); 
end;

Zugriffe seit 6.9.2001 auf Delphi-Ecke