Einzelnen Beitrag anzeigen

DBR

Registriert seit: 19. Jul 2005
38 Beiträge
 
#24

AW: StringReplace-Funktion etwas aufbohren

  Alt 25. Jul 2022, 14:53
Ich habe mir vor längerer Zeit mal einen Code gebastelt, der eingeklammerte Begriffe übergeht, und bei dem man zusätzlich bestimmen kann, wieviel Ersetzungen vorgenommen werden können. Nach längerem Suchen habe ich das Ding gefunden. Man braucht nur normale Klammern gegen spitze austauschen! Vielleicht hilft es. Wenn nicht, dann eben nicht.
Gruß DBR

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;
  Mit Zitat antworten Zitat