paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 20:59:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: add optional Count parameter to Utf8StringReplace/Utf16StringReplace.

Browse Source 
git-svn-id: trunk@60426 -
This commit is contained in:
bart 2019-02-15 13:56:08 +00:00
parent 7c5fdfc1d4
commit c452fc00e6
2 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
components/lazutils/lazutf16.pas
View File

@ -45,7 +45,8 @@ function UTF16CharacterToUnicode(p: PWideChar; out CharLen: integer): Cardinal;
function UnicodeToUTF16(u: cardinal): widestring;
function IsUTF16CharValid(AChar, ANextChar: WideChar): Boolean;
function IsUTF16StringValid(AWideStr: widestring): Boolean;
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString; Inline;
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString; out Count: Integer; Flags: TReplaceFlags): WideString;
function UnicodeLowercase(u: cardinal): cardinal;
{$IFDEF FPC}
@ -255,14 +256,24 @@ begin
end;
end;
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString;
Flags: TReplaceFlags): WideString;
var
DummyCount: Integer;
begin
Result := Utf16StringReplace(S, OldPattern, NewPattern, DummyCount, Flags);
end;
//Same as SysUtil.StringReplace but for WideStrings/UnicodeStrings, since it's not available in fpc yet
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
function Utf16StringReplace(const S, OldPattern, NewPattern: WideString; out Count: Integer;
Flags: TReplaceFlags): WideString;
var
Srch, OldP, RemS: WideString; // Srch and OldP can contain WideUpperCase versions of S,OldPattern
P: Integer;
begin
Srch:=S;
OldP:=OldPattern;
Count := 0;
if rfIgnoreCase in Flags then
begin
Srch:=WideUpperCase(Srch);
@ -280,6 +291,7 @@ begin
end
else
begin
Inc(Count);
Result:=Result+Copy(RemS,1,P-1)+NewPattern;
P:=P+Length(OldP);
RemS:=Copy(RemS,P,Length(RemS)-P+1);

12
components/lazutils/lazutf8.pas
View File

@ -122,6 +122,8 @@ procedure UTF8Insert(const source: Utf8String; var s: Utf8String; StartCharIndex
{$ENDIF}
procedure UTF8Insert(const source: String; var s: String; StartCharIndex: PtrInt);
function UTF8StringReplace(const S, OldPattern, NewPattern: String;
Flags: TReplaceFlags; ALanguage: string=''): String; inline;
function UTF8StringReplace(const S, OldPattern, NewPattern: String; out Count: Integer;
Flags: TReplaceFlags; ALanguage: string=''): String;
function UTF8LowerCase(const AInStr: string; ALanguage: string=''): string;
@ -1153,6 +1155,14 @@ begin
end;
function UTF8StringReplace(const S, OldPattern, NewPattern: String;
Flags: TReplaceFlags; ALanguage: string): String; inline;
var
DummyCount: Integer;
begin
Result := Utf8StringReplace(S, OldPattern, NewPattern, DummyCount, Flags, ALanguage);
end;
function UTF8StringReplace(const S, OldPattern, NewPattern: String; out Count: Integer;
Flags: TReplaceFlags; ALanguage: string): String;
// same algorithm as StringReplace, but using UTF8LowerCase
// for case insensitive search
@ -1162,6 +1172,7 @@ var
begin
Srch := S;
OldP := OldPattern;
Count := 0;
if rfIgnoreCase in Flags then
begin
Srch := UTF8LowerCase(Srch,ALanguage);
@ -1179,6 +1190,7 @@ begin
end
else
begin
Inc(Count);
Result := Result + Copy(RemS,1,P-1) + NewPattern;
P := P + Length(OldP);
RemS := Copy(RemS, P, Length(RemS)-P+1);