I'm working with Delphi 2007 and SynEdit component.
I'm the main developer of an open source editor (Tinn-R) and I'm trying to switch from the SynEdit ANSI to UNICODE.
After some months of work everything is working fine except OnPaintTransient procedure.
To try to discover the source of the problem I have tried the original demo OnPaintTransientDemo.
This works perfectly in the latest ANSI version of SynEdit. However, I'm not getting the same result with the latest UNICODE version.
if the instruction occupies only one line, only one symbol "[] {} or ()" near at the cursor is mistakenly highlighted, which closes not.
In other words, when you click on the first bracket "(" the last bracket ")" doesn't change color.
It should color the start and end tag. For example, considering "|" as the cursor position:
(|aaaa) -> only ( is highlighted
(aaaa|) -> only ) is highlighted
However, if the symbols are in different lines both are correctly highlighted:
(|a
a
a
a) -> both () are highlighted
(a
a
a
a|) -> both () are highlighted
This is looking like a bug in the sources of the component!
(Doing debug I could not find the source of the bug.)
Anyone can help please?
The code below (IceMan is the original author) works fine for me:
procedure TForm1.EditorPaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);
var
Editor: TSynEdit;
OpenChars: array of WideChar;//[0..2] of WideChar=();
CloseChars: array of WideChar;//[0..2] of WideChar=();
Attri: TSynHighlighterAttributes;
function IsCharBracket(AChar: WideChar): Boolean;
begin
case AChar of
'{',
'[',
'(',
'<',
'}',
']',
')',
'>':
Result:= True;
else
Result:= False;
end;
end;
function CharToPixels(P: TBufferCoord): TPoint;
begin
Result:=Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P));
end;
procedure SetCanvasStyle;
begin
Editor.Canvas.Brush.Style:= bsSolid; //Clear;
Editor.Canvas.Font.Assign(Editor.Font);
Editor.Canvas.Font.Style:= Attri.Style;
if (TransientType = ttAfter) then begin
Editor.Canvas.Font.Color:= FBracketFG;
Editor.Canvas.Brush.Color:= FBracketBG;
end
else begin
Editor.Canvas.Font.Color:= Attri.Foreground;
Editor.Canvas.Brush.Color:= Attri.Background;
end;
if (Editor.Canvas.Font.Color = clNone) then
Editor.Canvas.Font.Color:= Editor.Font.Color;
if (Editor.Canvas.Brush.Color = clNone) then
Editor.Canvas.Brush.Color:= Editor.Color;
end;
var
P : TBufferCoord;
Pix: TPoint;
D : TDisplayCoord;
S : WideString;
I,
ArrayLength,
start: Integer;
TmpCharA,
TmpCharB: WideChar;
begin
try
// if Memo1.InReplaceStatus = False then
// begin
(*
if fMain.SyntaxHEnabled = False then exit;
if Memo1.Highlighter = nil then exit;
if fMain.BracketMatching = False then exit;
if TSynEdit(Sender).SelAvail then exit;
*)
Editor:= TSynEdit(Sender);
ArrayLength:= 3;
(*
if (Editor.Highlighter = SynHTMLSyn1) or (Editor.Highlighter = SynXMLSyn1) then
inc(ArrayLength);
*)
SetLength(OpenChars,
ArrayLength);
SetLength(CloseChars,
ArrayLength);
for i:= 0 to ArrayLength - 1 do
Case i of
0: begin
OpenChars[i]:= '(';
CloseChars[i]:= ')';
end;
1: begin
OpenChars[i]:= '{';
CloseChars[i]:= '}';
end;
2: begin
OpenChars[i]:= '[';
CloseChars[i]:= ']';
end;
3: begin
OpenChars[i]:= '<';
CloseChars[i]:= '>';
end;
end;
P:= Editor.CaretXY;
D:= Editor.DisplayXY;
Start:= Editor.SelStart;
if (Start > 0) and
(Start <= length(Editor.Text)) then
TmpCharA:= Editor.Text[Start]
else
TmpCharA:= #0;
if (Start < length(Editor.Text)) then
TmpCharB:= Editor.Text[Start + 1]
else
TmpCharB:= #0;
if not IsCharBracket(TmpCharA) and
not IsCharBracket(TmpCharB) then
Exit;
S:= TmpCharB;
if not IsCharBracket(TmpCharB) then begin
P.Char:= P.Char - 1;
S:= TmpCharA;
end;
Editor.GetHighlighterAttriAtRowCol(P,
S,
Attri);
if (Editor.Highlighter.SymbolAttribute = Attri) then begin
for i:= low(OpenChars) to High(OpenChars) do begin
if (S = OpenChars[i]) or
(S = CloseChars[i]) then begin
Pix:= CharToPixels(P);
SetCanvasStyle;
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
S);
P := Editor.GetMatchingBracketEx(P);
if (P.Char > 0) and
(P.Line > 0) then begin
Pix:= CharToPixels(P);
if Pix.X > Editor.Gutter.Width then begin
SetCanvasStyle;
if S = OpenChars[i] then
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
CloseChars[i])
else
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
OpenChars[i]);
end; //if Pix.X >
end; //if (P.Char > 0)
end; //if (S = OpenChars[i])
end; //for i:= low(OpenChars)
Editor.Canvas.Brush.Style := bsSolid;
end; //if (Editor.Highlighter.SymbolAttribute = Attri)
except
// TODO
end; //try
end;
CharToPixels messes with the font color, I found. Setting font.color back to FBrackBG just before drawing seems to work.
Related
How can I effectively check if a string contains one of a few sub strings?
Suppose I have a string:
`Hi there, <B>my</B> name is Joe <DIV>.</DIV> Hello world. `
How can I check if the string contains either <B> OR <DIV> OR ?
I could do a simple:
Result := (Pos('<B>', S) > 0) or
(Pos('<DIV>', S) > 0) or
(Pos(' ', S) > 0);
But this seems to be very inefficient since it make N (at worst) passes and my strings are considerably large.
Slightly better version:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
i, j, Ln: Integer;
begin
for i := 1 to Length(S) do
begin
CurrChr := #S[i];
for j := 0 to High(AnyOf) do
begin
C := #AnyOf[j][1]; // assume that no empty strings
if C^ <> CurrChr^ then
Continue;
Ln := Length(AnyOf[j]);
if (Length(S) + 1 - i) < Ln then // check bounds
Continue;
if CompareMem(C, CurrChr, Ln * SizeOf(C^)) then
Exit(True);
end;
end;
Exit(False);
end;
You can also build some table of stop-symbols and improve speed. It's kinda complex topic, so I can just suggest you to read, for example, book Bill Smyth "Computing Patterns in Strings".
Here is my solution, thanks to David Heffernan comment:
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
CurrChr, C: PChar;
I, L, H: Integer;
begin
Result := False;
CurrChr := PChar(S);
while CurrChr^ <> #0 do
begin
H := High(AnyOf);
for I := 0 to H do
begin
L := 0;
C := PChar(AnyOf[I]);
while C^ <> #0 do
begin
if C^ = CurrChr^ then
Inc(L)
else
Break;
Inc(C);
Inc(CurrChr);
if CurrChr^ = #0 then // end of S string
begin
Result := (C^ = #0);
if Result or (not Result and (I = H)) then // match or last AnyOf
Exit;
end;
end;
if C^ = #0 then // match
begin
Result := True;
Exit;
end
else
Dec(CurrChr, L);
end;
Inc(CurrChr);
end;
end;
I'm not sure it is perfect.
EDIT:
What can I say? You know what they say about assumptions...
after actually testing, it seems like using Pos():
function StringContainsAny(const S: string; const AnyOf: array of string): Boolean;
var
I: Integer;
begin
for I := 0 to High(AnyOf) do
begin
if Pos(AnyOf[I], S) <> 0 then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
Is faster than my solution and #Green_Wizard solution! they did a good job with the Pos function!
I'm struggling with dealing with Ansi code strings. I'm getting the [32m, [37m, [K etc chars.
Is there a quicker way to eliminate/strip the ansi codes from the strings I get rather than doing it with the loop through chars searching for the beginning and end points of the ansi codes?
I know the declaration is something like this: #27'['#x';'#y';'#z'm';
where x, y, z... are the ANSI codes. So I assume I should be searching for #27 until I find "m;"
Are there any already made functions to achieve what I want? My search returned nothing except this article.
Thanks
You can treat this protocol very fast with code like this (simplest finite state machine):
var
s: AnsiString;
i: integer;
InColorCode: Boolean;
begin
s := 'test'#27'['#5';'#30';'#47'm colored text';
InColorCode := False;
for i := 1 to Length(s) do
if InColorCode then
case s[i] of
#0: TextAttrib = Normal;
...
#47: TextBG := White;
'm': InColorCode := false;
else;
// I do nothing here for `;`, '[' and other chars.
// treat them if necessary
end;
else
if s[i] = #27 then
InColorCode := True
else
output char with current attributes
Clearing string from ESC-codes:
procedure StripEscCode(var s: AnsiString);
const
StartChar: AnsiChar = #27;
EndChar: AnsiChar = 'm';
var
i, cnt: integer;
InEsc: Boolean;
begin
Cnt := 0;
InEsc := False;
for i := 1 to Length(s) do
if InEsc then begin
InEsc := s[i] <> EndChar;
Inc(cnt)
end
else begin
InEsc := s[i] = StartChar;
if InEsc then
Inc(cnt)
else
s[i - cnt] :=s[i];
end;
setLength(s, Length(s) - cnt);
end;
I'm trying to make a function that can increment a filename.
If last char of the string is a number then increment it.
If last char is a letter then add _1 or _2 or _3(increment this also).
I have to be sure the filename is unique but i cannot use datetime inside filename because all the filenames must be <32 chars without extension.
EX: Apple_99.txt =>Apple_100
Ex: Apple_173 => Apple_174
EX: This_is_my_first_text.txt => This_is_my_first_text_1.txt
Ex: This_is_my_first_text_9.txt => This_is_my_first_text_10.txt
I need to use this in order to rename a file an then upload it to a ftp server.
I've found a function that can do something like this but it only works if the filename contains only uppercase.How can I modify this function in order to access lowercase an uppercase string?
Here is the function:
function IncStr(Str: String; Amount: Integer; Index: Integer = -1): String;
const
MIN_VAL = 65; // 'A'
MAX_VAL = 90; // 'Z'
var
Digit, ToAdd, ToCarry: Integer;
begin
if (Index = 0) and (Amount > 0) then
begin
Result := Char(MIN_VAL + Amount - 1) + Str;
Exit;
end;
if Index = -1 then Index := Length(Str);
ToCarry := 0;
Digit := Ord(Str[Index]);
while not (Digit in [MIN_VAL..MAX_VAL]) do
begin
Dec(Index);
Digit := Ord(Str[Index]);
end;
ToAdd := Digit + Amount;
while (ToAdd > MAX_VAL) do
begin
Dec(ToAdd, 26);
Inc(ToCarry);
end;
Result := Str;
Result[Index] := Char(ToAdd);
if (ToCarry > 0) then
Result := IncStr(Result, ToCarry, Index - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: String; // holds string to increment
C: Integer; // amount to increment by
begin
// make sure that Edit1 starts with a valid character
// i.e. 'A' to 'Z'
S := Edit1.Text;
C := StrtoIntDef(Edit2.Text, 0);
// test it, place result in Edit3
Edit3.Text := IncStr(S, C);
{
Example data:
Edit1 := AAZ
Edit2 := 2
= Edit3 := ABB
Edit1 := BZY
Edit2 := 3
= Edit3 := CAB
Edit1 := ZZZ
Edit2 := 1
= Edit3 := AAAA
Edit1 := AA-AC
Edit2 := 3
= Edit3 := AA-AF
Edit1 := AA/Z
Edit2 := 5
= Edit3 := AB/E
... etc
Here's one to try too :-)
Edit1 := ZZZ
Edit2 := 264172
}
end;
Thank you!
Like so many programming problems, the key is to break the problem down into small pieces. First of all, let's write a function to decode the original file name into its constituent parts:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := Stem.LastIndexOf('_');
if P = -1 then begin
exit;
end;
if TryStrToInt(Stem.Substring(P+1), Number) then begin
Stem := Stem.Substring(0, P);
end;
end;
The following demonstrates how this works:
DecodeFileName('test.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_dd.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_23.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
The output is:
test, 0, .txt
test_dd, 0, .txt
test, 23, .txt
So now you can make a new filename like this:
function IncrementedFileName(const FileName: string): string;
var
Stem, Ext: string;
Number: Integer;
begin
DecodeFileName(FileName, Stem, Ext, Number);
Result := Format('%s_%d%s', [Stem, Number+1, Ext]);
end;
And then we can see how that performs:
Writeln(IncrementedFileName('test.txt'));
Writeln(IncrementedFileName('test_dd.txt'));
Writeln(IncrementedFileName('test_23.txt'));
Writeln(IncrementedFileName('test_28'));
The output is:
test_1.txt
test_dd_1.txt
test_24.txt
test_29
If you don't have access to the string helper methods then you can code it like this:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := LastDelimiter('_', Stem);
if P = 0 then begin
exit;
end;
if TryStrToInt(Copy(Stem, P+1, MaxInt), Number) then begin
Stem := Copy(Stem, 1, P-1);
end;
end;
I have not executed this final function, so do not be surprised if it has errors.
I have a status which is stored as a string of a set length, either in a file or a database.
I'm looking to enumerate the possible status'
I have the following type to define the possible status'
Type TStatus = (fsNormal = Ord('N'),fsEditedOnScreen = Ord('O'),
fsMissing = Ord('M'),fsEstimated = Ord('E'),fsSuspect = Ord('s'),
fsSuspectFromOnScreen = Ord('o'),fsSuspectMissing = Ord('m'),
fsSuspectEstimated = Ord('e'));
Firstly is this really a good idea? or should I have a seperate const array storing the char conversions? That would mean more than one place to update.
Now convert a string to a status array I have the following, but how can I check if a char is valid without looping through the enumeration?
Function StrToStatus(Value : String):TStatusArray;
var
i: Integer;
begin
if Trim(Value) = '' then
begin
SetLength(Result,0);
Exit;
end;
SetLength(Result,Length(Value));
for i := 1 to Length(Value) do
begin
Result[i] := TStatus(Value[i]); // I don't think this line is safe.
end;
end;
After some testing it sames the suspect line is safe (it doesn't crash!) but just adds in (out of bounds) values which then need filtering out.
Function StrToStatus(Value : String):TStatusArray;
var
i: Integer;
begin
if Trim(Value) = '' then
begin
SetLength(Result,0);
Exit;
end;
SetLength(Result,Length(Value));
for i := 1 to Length(Value) do
begin
Result[i-1] := TStatus(Value[i]);
end;
for i := 0 to Length(Result) - 1 do
begin
case Result[i] of
fsNormal: ;
fsEditedOnScreen: ;
fsMissing: ;
fsEstimated: ;
fsSuspect: ;
fsSuspectFromOnScreen: ;
fsSuspectMissing: ;
fsSuspectEstimated: ;
else
Result [i] := fsNormal;
end;
end;
end;
This allows all the status' and their relative Char values to be in one place and prevents looping through every status for every character in the string. (So in my head atleast should be a bit faster)
AFAIK this should be fine for converting back again.
Function StatusToStr(Value : TStatusArray):String;
var
i: Integer;
begin
for i := 0 to Length(Value) - 1 do
Result := Result + Chr(Ord(Value[i]))
end;
I'm using Delphi 2007
If I understand you correctly I would replace the array with a set and use an enum without explicit values, like so:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TStatus = (fsNormal, fsEditedOnScreen, fsMissing, fsEstimated, fsSuspect,
fsSuspectFromOnScreen, fsSuspectMissing, fsSuspectEstimated);
TStatusSet = set of TStatus;
const
cStatusChars: array[TStatus] of Char = ('N', 'O', 'M', 'E', 's', 'o', 'm', 'e');
function CharToStatus(AChar: Char; out AStatus: TStatus): Boolean;
var
st: TStatus;
begin
for st := Low(TStatus) to High(TStatus) do
if cStatusChars[st] = AChar then
begin
AStatus := st;
Result := True;
Exit;
end;
Result := False;
end;
function StrToStatus(const Value: string): TStatusSet;
var
i: Integer;
st: TStatus;
begin
Result := [];
for i := 1 to Length(Value) do
if CharToStatus(Value[i], st) then
Include(Result, st);
end;
function StatusToStr(const Value: TStatusSet): string;
var
st: TStatus;
begin
for st in Value do
Result := Result + cStatusChars[st];
end;
var
StatusSet: TStatusSet;
begin
StatusSet := StrToStatus('EmO');
Writeln(StatusToStr(StatusSet));
Readln;
end.
First, I wonder why you save it as string instead of as integer.
The way you've done it, the only way to do it correctly would be to have a Case condition...
function CharToStatus(AChar : Char):TStatus;
begin
case AChar of
'N' : Result := fsNormal;
'O' : Result := fsEditedOnScreen;
'M' : Result := fsMissing;
'E' : Result := fsEstimated;
's' : Result := fsSuspect;
'o' : Result := fsSuspectFromOnScreen;
'm' : Result := fsSuspectMissing;
'e' : Result := fsSuspectEstimated;
else
//Manage error;
end;
end;
function StatusToChar(AStatus : TStatus) : char;
begin
Result := Char(AStatus);
end;
The expression x in [Low(TStatus)]..High(Tstatus)] won't work in this situation.
The reason for this is that Low(TStatus) = 'E', and High(TStatus) = 's'. Anything in-between would be considered valid. (i.e. 'Z' is in [Low(TStatus)]..High(Tstatus)])
The expression x in [Low(TStatus)]..High(Tstatus)] only work on type where there is no "hole" in the declaration. (Like those without explicit values, where the first element is 0, 2nd is 1, 3rd is 2... etc)
//EDIT
Ok.. thinking the problem a bit further, I don't see why you don't like the const array approach... Something like this would be a lot better.
type
TStatus = (fsNormal, fsEditedOnScreen,
fsMissing,fsEstimated,fsSuspect,
fsSuspectFromOnScreen,fsSuspectMissing ,
fsSuspectEstimated);
const
StatusValue : Array[TStatus] of Char = ('N','O','M','E','s','o','m','e');
function StatusValueToTStatus(C : Char) : TStatus;
var I : Integer;
begin
for I := Low(StatusValue) to High(StatusValue) do
begin
if StatusValue = C then
begin
Result := TStatus(I);
EXIT;
end;
end;
//Not found, Manage errors
end;
I am using StringReplace to replace > and < by the char itself in a generated XML like this:
StringReplace(xml.Text,'>','>',[rfReplaceAll]) ;
StringReplace(xml.Text,'<','<',[rfReplaceAll]) ;
The thing is it takes way tooo long to replace every occurence of >.
Do you purpose any better idea to make it faster?
If you're using Delphi 2009, this operation is about 3 times faster with TStringBuilder than with ReplaceString. It's Unicode safe, too.
I used the text from http://www.CodeGear.com with all occurrences of "<" and ">" changed to "<" and ">" as my starting point.
Including string assignments and creating/freeing objects, these took about 25ms and 75ms respectively on my system:
function TForm1.TestStringBuilder(const aString: string): string;
var
sb: TStringBuilder;
begin
StartTimer;
sb := TStringBuilder.Create;
sb.Append(aString);
sb.Replace('>', '>');
sb.Replace('<', '<');
Result := sb.ToString();
FreeAndNil(sb);
StopTimer;
end;
function TForm1.TestStringReplace(const aString: string): string;
begin
StartTimer;
Result := StringReplace(aString,'>','>',[rfReplaceAll]) ;
Result := StringReplace(Result,'<','<',[rfReplaceAll]) ;
StopTimer;
end;
Try FastStrings.pas from Peter Morris.
You should definitely look at the Fastcode project pages: http://fastcode.sourceforge.net/
They ran a challenge for a faster StringReplace (Ansi StringReplace challenge), and the 'winner' was 14 times faster than the Delphi RTL.
Several of the fastcode functions have been included within Delphi itself in recent versions (D2007 on, I think), so the performance improvement may vary dramatically depending on which Delphi version you are using.
As mentioned before, you should really be looking at a Unicode-based solution if you're serious about processing XML.
The problem is that you are iterating the entire string size twice (one for replacing > by > and another one to replace < by <).
You should iterate with a for and simply check ahead whenever you find a & for a gt; or lt; and do the immediate replace and then skipping 3 characters ((g|l)t;). This way it can do that in proportional time to the size of the string xml.Text.
A simple C# example as I do not know Delphi but should do for you to get the general idea.
String s = "<xml>test</xml>";
char[] input = s.ToCharArray();
char[] res = new char[s.Length];
int j = 0;
for (int i = 0, count = input.Length; i < count; ++i)
{
if (input[i] == '&')
{
if (i < count - 3)
{
if (input[i + 1] == 'l' || input[i + 1] == 'g')
{
if (input[i + 2] == 't' && input[i + 3] == ';')
{
res[j++] = input[i + 1] == 'l' ? '<' : '>';
i += 3;
continue;
}
}
}
}
res[j++] = input[i];
}
Console.WriteLine(new string(res, 0, j));
This outputs:
<xml>test</xml>
When you are dealing with a multiline text files, you can get some performance by processing it line by line. This approach reduced time in about 90% to replaces on >1MB xml file.
procedure ReplaceMultilineString(xml: TStrings);
var
i: Integer;
line: String;
begin
for i:=0 to xml.Count-1 do
begin
line := xml[i];
line := StringReplace(line, '>', '>', [rfReplaceAll]);
line := StringReplace(line, '<', '<', [rfReplaceAll]);
xml[i] := line;
end;
end;
Untested conversion of the C# code written by Jorge Ferreira.
function ReplaceLtGt(const s: string): string;
var
inPtr, outPtr: integer;
begin
SetLength(Result, Length(s));
inPtr := 1;
outPtr := 1;
while inPtr <= Length(s) do begin
if (s[inPtr] = '&') and ((inPtr + 3) <= Length(s)) and
(s[inPtr+1] in ['l', 'g']) and (s[inPtr+2] = 't') and
(s[inPtr+3] = ';') then
begin
if s[inPtr+1] = 'l' then
Result[outPtr] := '<'
else
Result[outPtr] := '>';
Inc(inPtr, 3);
end
else begin
Result[outPtr] := Result[inPtr];
Inc(inPtr);
end;
Inc(outPtr);
end;
SetLength(Result, outPtr - 1);
end;
Systools (Turbopower, now open source) has a ReplaceStringAllL function that does all of them in a string.
it's work like charm so fast trust it
Function NewStringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
OldPat,Srch: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
PatLength,NewPatLength,P,i,PatCount,PrevP: Integer;
c,d: pchar;
begin
PatLength:=Length(OldPattern);
if PatLength=0 then begin
Result:=S;
exit;
end;
if rfIgnoreCase in Flags then begin
Srch:=AnsiUpperCase(S);
OldPat:=AnsiUpperCase(OldPattern);
end else begin
Srch:=S;
OldPat:=OldPattern;
end;
PatLength:=Length(OldPat);
if Length(NewPattern)=PatLength then begin
//Result length will not change
Result:=S;
P:=1;
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
for i:=1 to PatLength do
Result[P+i-1]:=NewPattern[i];
if not (rfReplaceAll in Flags) then exit;
inc(P,PatLength);
end;
until p=0;
end else begin
//Different pattern length -> Result length will change
//To avoid creating a lot of temporary strings, we count how many
//replacements we're going to make.
P:=1; PatCount:=0;
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
inc(P,PatLength);
inc(PatCount);
if not (rfReplaceAll in Flags) then break;
end;
until p=0;
if PatCount=0 then begin
Result:=S;
exit;
end;
NewPatLength:=Length(NewPattern);
SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength));
P:=1; PrevP:=0;
c:=pchar(Result); d:=pchar(S);
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
for i:=PrevP+1 to P-1 do begin
c^:=d^;
inc(c); inc(d);
end;
for i:=1 to NewPatLength do begin
c^:=NewPattern[i];
inc(c);
end;
if not (rfReplaceAll in Flags) then exit;
inc(P,PatLength);
inc(d,PatLength);
PrevP:=P-1;
end else begin
for i:=PrevP+1 to Length(S) do begin
c^:=d^;
inc(c); inc(d);
end;
end;
until p=0;
end;
end;