// Es geht darum
ein anderes Stringreplace einzusetzen, bei dem man angeben
// kann, dass das neue Wort in der Schreibweise an das alte Wort
angepasst
// wird, und auch wieviele Mal eine Zeichenfolge ersetzt werden soll.
// Alte
Version
// Getestet mit D4 unter WinME
type
TMyReplaceType = set of (IgnoreCase, SameSpelling);
function MyReplace(const s, OldPattern, NewPattern: string; Number: integer;
Way: TMyReplaceType): string;
var
mq, mz: TStringStream;
x, z, lga, lgn, lgs: integer;
c, v: string;
procedure withcomparison;
var i, j: integer;
begin
if lga <= lgn then begin
j := lgn - lga;
for i := 1 to lga do
if isCharUpper(c[i]) then
charupperbuff(@mz.datastring[i + x + z * j], 1)
else charlowerbuff(@mz.datastring[i + x + z * j], 1);
if lgn > lga then begin
if isCharUpper(c[lga]) then
charupperbuff(@mz.datastring[x + lga + z * j + 1], j) else
charlowerbuff(@mz.datastring[x + lga + z * j + 1], j);
end;
end else begin
j := lga - lgn;
for i := 1 to lgn do
if isCharUpper(c[i]) then
charupperbuff(@mz.datastring[i + x - z * j], 1)
else charlowerbuff(@mz.datastring[i + x - z * j], 1);
end;
end;
begin
lga := length(OldPattern);
if (lga > 0) then begin
lgn := length(NewPattern);
z := 0;
v := ansilowercase(OldPattern);
lgs := length(s);
setlength(c, lga);
mq := TStringStream.create(s);
mz := TStringStream.create(result);
try
x := 0;
while x <= mq.size - lga do begin
mq.position := x;
mq.readbuffer(c[1], lga);
if (c = OldPattern) or ((IgnoreCase in Way) and (ansilowercase(c) = v))
then begin
if lgn > 0 then begin
mz.writebuffer(NewPattern[1], lgn);
if SameSpelling in Way then withcomparison;
end;
inc(z);
inc(x, lga);
if z = Number then break;
end else begin
mz.writebuffer(c[1], 1);
inc(x);
end;
end;
mq.position := x;
if x < lgs then
mz.copyfrom(mq, lgs - x);
result := mz.datastring;
finally
mz.free;
mq.free;
end;
end else result := s;
end;
// Beispielaufruf: Vergleich StringReplace mit MyReplace
procedure TFormx.BitBtn2Click(Sender: TObject);
begin
richedit1.lines.add(MyReplace('Ich bin im Nebenhaus', 'Haus', 'GEBÄUDE', -1,
[SameSpelling, Ignorecase]));
richedit1.lines.add(StringReplace('Ich bin im Nebenhaus', 'Haus', 'GEBÄUDE',
[rfIgnorecase, rfReplaceall]));
end;
Ergebnis Myreplace:
Ich bin im Nebengebäude
Ergebnis StringReplace: Ich bin im NebenGEBÄUDE
//------------------------------------------------------------------------
//
Neue Version
// Getestet mit RS 10.4 unter W11
//
Zusätzlich kann man jeden Buchstabe einzeln an die Schreibweise
anpassen.
type
TMyReplaceType = set of (IgnoreCase, SameSpelling, EachLetter);
function NewReplace(const s, OldPattern, NewPattern: string; Number: Integer;
Way: TMyReplaceType): string;
var
x, z, lga, lgn, lgs: Integer;
c, v: string;
b: Boolean;
function withcomparison(ac: String; lg: Integer): String;
var
i: Integer;
rs: string;
begin
if b then
begin
rs := '';
for i := lg + 1 to lg + lgn do
if isCharLower(s[i]) then
rs := rs + LowerCase(NewPattern[i - lg])
else
rs := rs + UpperCase(NewPattern[i - lg]);
Result := rs;
end
else if isCharLower(ac[1]) and (SameSpelling in Way) then
begin
Result := AnsiLowercase(NewPattern);
end
else
Result := NewPattern;
end;
begin
try
lga := length(OldPattern);
if lga = 0 then
begin
Result := s;
exit;
end;
b := EachLetter in Way;
lgn := length(NewPattern);
if b and (lga <> lgn) then
begin
showmessage('Bei EachLetter müssen OldPattern and NewPattern ' +
'die gleiche Länge haben');
Result := s;
exit;
end;
z := 0;
v := LowerCase(OldPattern);
lgs := length(s);
x := 1;
while x <= lgs do
begin
c := copy(s, x, lga);
if (c = OldPattern) or ((IgnoreCase in Way) and (AnsiLowercase(c) = v))
then
begin
if lgn > 0 then
begin
Result := Result + withcomparison(Ansilastchar(Result),
length(Result));
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 := s;
showmessage('Unerwarteter Fehler');
end;
end;
// Alle Begriffe ersetzen
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.Clear;
RichEdit1.lines.add
(NewReplace('Ich bin im Nebenhaus, Vorderhaus oder Hinterhaus', 'Haus',
'GEBÄUDE', -1, [SameSpelling, IgnoreCase]));
end;
Ergebnis: Ich bin im Nebengebäude, Vordergebäude oder Hintergebäude
// Nur die ersten zwei Begriffe ersetzen
procedure TForm1.Button2Click(Sender: TObject);
begin
RichEdit1.Clear;
RichEdit1.lines.add
(NewReplace('Ich bin im Nebenhaus, Vorderhaus oder Hinterhaus', 'Haus',
'GEBÄUDE', 2, [SameSpelling, IgnoreCase]));
end;
Ergebnis Ich bin im Nebengebäude, Vordergebäude oder Hinterhaus
// Ersetzung buchstabenweise vornehmen
procedure TForm1.Button3Click(Sender: TObject);
begin
RichEdit1.Clear;
RichEdit1.lines.add(NewReplace('Test TEST test tESt ', 'test', 'Jazz', -1,
[EachLetter, IgnoreCase]));
end;
Ergebnis: Jazz JAZZ jazz jAZz

|